[Dart-dev] [6861] DART/trunk: Extended support for filenames to 256 characters.
nancy at ucar.edu
nancy at ucar.edu
Tue Mar 25 16:49:41 MDT 2014
Revision: 6861
Author: thoar
Date: 2014-03-25 16:49:41 -0600 (Tue, 25 Mar 2014)
Log Message:
-----------
Extended support for filenames to 256 characters.
The error message strings are then 512 characters.
tested with filenames about 160 characters long - works.
By 'filenames', I mean namelist variables that point to files,
as well as the obs sequence filenames themselves.
Modified Paths:
--------------
DART/trunk/diagnostics/threed_sphere/obs_diag.f90
DART/trunk/obs_sequence/obs_seq_to_netcdf.f90
DART/trunk/obs_sequence/obs_sequence_mod.f90
DART/trunk/utilities/utilities_mod.f90
-------------- next part --------------
Modified: DART/trunk/diagnostics/threed_sphere/obs_diag.f90
===================================================================
--- DART/trunk/diagnostics/threed_sphere/obs_diag.f90 2014-03-25 22:32:39 UTC (rev 6860)
+++ DART/trunk/diagnostics/threed_sphere/obs_diag.f90 2014-03-25 22:49:41 UTC (rev 6861)
@@ -86,9 +86,9 @@
type(obs_def_type) :: obs_def
type(location_type) :: obs_loc
-character(len = 129) :: obs_seq_in_file_name
-character(len = 129), allocatable, dimension(:) :: obs_seq_filenames
-character(len = stringlength), dimension(MaxTrusted) :: trusted_list = 'null'
+character(len=256) :: obs_seq_in_file_name
+character(len=256), allocatable, dimension(:) :: obs_seq_filenames
+character(len=stringlength), dimension(MaxTrusted) :: trusted_list = 'null'
! Storage with fixed size for observation space diagnostics
real(r8), dimension(1) :: prior_mean, posterior_mean, prior_spread, posterior_spread
@@ -121,7 +121,7 @@
type(random_seq_type) :: ran_seq
real(r8) :: obs_error_variance
-character(len=129) :: obs_seq_read_format
+character(len=stringlength) :: obs_seq_read_format
logical :: pre_I_format
integer, dimension(2) :: key_bounds
@@ -171,8 +171,8 @@
! Namelist with (some scalar) default values
!-----------------------------------------------------------------------
-character(len = 129) :: obs_sequence_name = 'obs_seq.final'
-character(len = 129) :: obs_sequence_list = ''
+character(len=256) :: obs_sequence_name = 'obs_seq.final'
+character(len=256) :: obs_sequence_list = ''
integer, dimension(6) :: first_bin_center = (/ 2003, 1, 1, 0, 0, 0 /)
integer, dimension(6) :: last_bin_center = (/ 2003, 1, 2, 0, 0, 0 /)
integer, dimension(6) :: bin_separation = (/ 0, 0, 0, 6, 0, 0 /)
@@ -190,10 +190,10 @@
integer :: Nregions = 0
real(r8), dimension(MaxRegions) :: lonlim1= MISSING_R8, lonlim2= MISSING_R8
real(r8), dimension(MaxRegions) :: latlim1= MISSING_R8, latlim2= MISSING_R8
-character(len = stringlength), dimension(MaxRegions) :: reg_names = 'null'
+character(len=stringlength), dimension(MaxRegions) :: reg_names = 'null'
type(location_type), dimension(MaxRegions) :: min_loc, max_loc
-character(len = stringlength), dimension(MaxTrusted) :: trusted_obs = 'null'
+character(len=stringlength), dimension(MaxTrusted) :: trusted_obs = 'null'
real(r8):: rat_cri = 5000.0_r8 ! QC ratio
real(r8):: input_qc_threshold = 3.0_r8 ! maximum NCEP QC factor
@@ -219,7 +219,7 @@
!-----------------------------------------------------------------------
integer, parameter :: Ncopies = 22
-character(len = stringlength), dimension(Ncopies) :: copy_names = &
+character(len=stringlength), dimension(Ncopies) :: copy_names = &
(/ 'Nposs ', 'Nused ', 'NbigQC ', 'NbadIZ ', 'NbadUV ', &
'NbadLV ', 'rmse ', 'bias ', 'spread ', 'totalspread', &
'NbadDARTQC ', 'observation', 'ens_mean ', &
@@ -298,7 +298,7 @@
! List of observations types augmented with 'WIND' types if need be.
! Replace calls to 'get_obs_kind_name' ---> index into 'obs_type_strings'
-character(len = stringlength), pointer, dimension(:) :: obs_type_strings
+character(len=stringlength), pointer, dimension(:) :: obs_type_strings
! These pairs of variables are used when we diagnose which observations
! are far from the background.
@@ -315,8 +315,8 @@
type(time_type) :: AllseqT1, AllseqTN ! first,last time in ALL observation sequences
type(time_type) :: obs_time, skip_time
-character(len = 256) :: ncName, string1, string2, string3
-character(len = stringlength) :: obsname
+character(len=512) :: string1, string2, string3
+character(len=stringlength) :: obsname, ncName
integer :: Nidentity = 0 ! identity observations
@@ -1846,7 +1846,7 @@
integer :: i
logical :: matched
-character(len = stringlength) :: possible_obs_type
+character(len=stringlength) :: possible_obs_type
! Loop over all user input candidates for 'trusted' observations.
! Check each candidate against list of known observation names.
@@ -1935,7 +1935,7 @@
! the scale_factor should be defined to reflect the type, which are not
! guaranteed to be numbered sequentially ... vortices 81, for example
-character(len = stringlength) :: obs_string
+character(len=stringlength) :: obs_string
integer :: ivar
scale_factor = 1.0_r8
@@ -3490,7 +3490,7 @@
Subroutine WriteNetCDF(fname)
-character(len=129), intent(in) :: fname
+character(len=*), intent(in) :: fname
integer :: ncid, i, indx1, nobs, typesdimlen
integer :: RegionDimID, RegionVarID
Modified: DART/trunk/obs_sequence/obs_seq_to_netcdf.f90
===================================================================
--- DART/trunk/obs_sequence/obs_seq_to_netcdf.f90 2014-03-25 22:32:39 UTC (rev 6860)
+++ DART/trunk/obs_sequence/obs_seq_to_netcdf.f90 2014-03-25 22:49:41 UTC (rev 6861)
@@ -68,8 +68,8 @@
type(obs_def_type) :: obs_def
type(location_type) :: obs_loc, minl, maxl
-character(len = 129) :: obs_seq_in_file_name
-character(len = 129), allocatable, dimension(:) :: obs_seq_filenames
+character(len=256) :: obs_seq_in_file_name
+character(len=256), allocatable, dimension(:) :: obs_seq_filenames
real(r8) :: obs_err_var
@@ -78,7 +78,7 @@
integer :: num_obs_kinds
-character(len=129) :: obs_seq_read_format
+character(len=stringlength) :: obs_seq_read_format
logical :: pre_I_format
logical :: out_of_range, is_there_one, keeper
@@ -87,8 +87,8 @@
! Namelist with (some scalar) default values
!-----------------------------------------------------------------------
-character(len = 129) :: obs_sequence_name = 'obs_seq.final'
-character(len = 129) :: obs_sequence_list = ''
+character(len=256) :: obs_sequence_name = 'obs_seq.final'
+character(len=256) :: obs_sequence_list = ''
real(r8) :: lonlim1= MISSING_R8, lonlim2= MISSING_R8
real(r8) :: latlim1= MISSING_R8, latlim2= MISSING_R8
@@ -146,8 +146,8 @@
real(digits12) :: mytime
integer :: seconds, days
-character(len = 129) :: ncName, calendarstring
-character(len = 129) :: string1, string2, string3
+character(len=stringlength) :: ncName, calendarstring
+character(len=512) :: string1, string2, string3
!=======================================================================
! Get the party started
Modified: DART/trunk/obs_sequence/obs_sequence_mod.f90
===================================================================
--- DART/trunk/obs_sequence/obs_sequence_mod.f90 2014-03-25 22:32:39 UTC (rev 6860)
+++ DART/trunk/obs_sequence/obs_sequence_mod.f90 2014-03-25 22:49:41 UTC (rev 6861)
@@ -80,8 +80,8 @@
! F95 allows pointers to be initialized to a known value.
! However, if you get an error on the following lines from your
! compiler, remove the => NULL() from the end of the 5 lines below.
- character(len = metadatalength), pointer :: copy_meta_data(:) => NULL()
- character(len = metadatalength), pointer :: qc_meta_data(:) => NULL()
+ character(len=metadatalength), pointer :: copy_meta_data(:) => NULL()
+ character(len=metadatalength), pointer :: qc_meta_data(:) => NULL()
integer :: first_time
integer :: last_time
! integer :: first_avail_time, last_avail_time
@@ -105,7 +105,6 @@
type obs_cov_type
private
integer :: num_cov_groups
-! ??????
end type obs_cov_type
! for errors
@@ -926,13 +925,14 @@
end subroutine delete_obs_from_seq
!-------------------------------------------------
+
subroutine set_copy_meta_data(seq, copy_num, meta_data)
! Need all sorts of error checking to avoid silly stuff eventually
type(obs_sequence_type), intent(inout) :: seq
integer, intent(in) :: copy_num
-character(len = *), intent(in) :: meta_data
+character(len=*), intent(in) :: meta_data
character(len=len(meta_data)) :: lj_meta_data ! left justified version
@@ -962,7 +962,7 @@
! Need error checks
type(obs_sequence_type), intent(inout) :: seq
integer, intent(in) :: qc_num
-character(len = *), intent(in) :: meta_data
+character(len=*), intent(in) :: meta_data
character(len=len(meta_data)) :: lj_meta_data ! left justified version
@@ -1033,7 +1033,7 @@
type(obs_sequence_type), intent(inout) :: seq
integer, intent(in) :: num_to_add
-character(len = metadatalength) :: meta_temp(seq%num_copies)
+character(len=metadatalength) :: meta_temp(seq%num_copies)
real(r8) :: values_temp(seq%num_copies)
integer :: i, old_num
@@ -1080,7 +1080,7 @@
type(obs_sequence_type), intent(inout) :: seq
integer, intent(in) :: num_to_add
-character(len = metadatalength) :: qc_temp(seq%num_qc)
+character(len=metadatalength) :: qc_temp(seq%num_qc)
real(r8) :: values_temp(seq%num_qc)
integer :: i, old_num
@@ -1119,7 +1119,7 @@
subroutine write_obs_seq(seq, file_name)
type(obs_sequence_type), intent(in) :: seq
-character(len = *), intent(in) :: file_name
+character(len=*), intent(in) :: file_name
integer :: i, file_id, rc
integer :: have(max_obs_kinds)
@@ -1209,14 +1209,14 @@
! Be able to increase size at read in time for efficiency
-character(len = *), intent(in) :: file_name
+character(len=*), intent(in) :: file_name
integer, intent(in) :: add_copies, add_qc, add_obs
type(obs_sequence_type), intent(out) :: seq
integer :: i, num_copies, num_qc, num_obs, max_num_obs, file_id, io
-character(len = 16) :: label(2)
+character(len=16) :: label(2)
logical :: pre_I_format
-character(len = 129) :: read_format
+character(len=32) :: read_format
! Use read_obs_seq_header to get file format and header info
call read_obs_seq_header(file_name, num_copies, num_qc, num_obs, &
@@ -1307,14 +1307,14 @@
! Be able to increase size at read in time for efficiency
-character(len = *), intent(in) :: file_name
-integer, intent(out) :: num_copies, num_qc, num_obs, max_num_obs, file_id
-character(len = *), intent(out) :: read_format
-logical, intent(out) :: pre_I_format
-logical, intent(in), optional :: close_the_file
+character(len=*), intent(in) :: file_name
+integer, intent(out) :: num_copies, num_qc, num_obs, max_num_obs, file_id
+character(len=*), intent(out) :: read_format
+logical, intent(out) :: pre_I_format
+logical, optional, intent(in) :: close_the_file
-character(len = 16) label(2)
-character(len = 12) header
+character(len=16) :: label(2)
+character(len=12) :: header
integer :: ios
! Determine the format for an obs_sequence file to be read. Options are:
@@ -2473,11 +2473,11 @@
! Are the checks for num_copies == 0 or <0 necessary?
! Yes, they happen in create_fixed_network_sequence
-integer, intent(in) :: file_id, num_copies, add_copies
-integer, intent(in) :: num_qc, add_qc, key
-character(len = *), intent(in) :: read_format
-type(obs_type), intent(inout) :: obs
-integer, optional, intent(in) :: max_obs
+integer, intent(in) :: file_id, num_copies, add_copies
+integer, intent(in) :: num_qc, add_qc, key
+character(len=*), intent(in) :: read_format
+type(obs_type), intent(inout) :: obs
+integer, optional, intent(in) :: max_obs
integer :: i, io
real(r8) :: temp_val
Modified: DART/trunk/utilities/utilities_mod.f90
===================================================================
--- DART/trunk/utilities/utilities_mod.f90 2014-03-25 22:32:39 UTC (rev 6860)
+++ DART/trunk/utilities/utilities_mod.f90 2014-03-25 22:49:41 UTC (rev 6861)
@@ -186,7 +186,7 @@
character(len=32 ), parameter :: revision = "$Revision$"
character(len=128), parameter :: revdate = "$Date$"
-character(len = 169) :: msgstring
+character(len=512) :: msgstring
!----------------------------------------------------------------
! Namelist input with default values
@@ -195,8 +195,8 @@
integer :: TERMLEVEL = E_ERR
! default log and namelist output filenames
-character(len=129) :: logfilename = 'dart_log.out'
-character(len=129) :: nmlfilename = 'dart_log.nml'
+character(len=256) :: logfilename = 'dart_log.out'
+character(len=256) :: nmlfilename = 'dart_log.nml'
! output each module subversion details
logical :: module_details = .true.
@@ -222,8 +222,8 @@
! integer :: logfileunit -- public module variable
integer :: iunit, io
- character(len=129) :: lname
- character(len=169) :: string1,string2,string3
+ character(len=256) :: lname
+ character(len=512) :: string1,string2,string3
if ( module_initialized ) then ! nothing to do
@@ -411,6 +411,9 @@
end subroutine initialize_utilities
+!#######################################################################
+
+
subroutine finalize_utilities(progname)
character(len=*), intent(in), optional :: progname
! integer :: logfileunit -- private module variable
@@ -450,6 +453,7 @@
!#######################################################################
+
subroutine register_module(src, rev, rdate)
character(len=*), intent(in) :: src, rev, rdate
@@ -476,8 +480,10 @@
end subroutine register_module
+
!#######################################################################
+
subroutine timestamp(string1,string2,string3,pos)
character(len=*), optional, intent(in) :: string1
@@ -505,8 +511,10 @@
end subroutine timestamp
+
!#######################################################################
+
function file_exist (file_name)
character(len=*), intent(in) :: file_name
@@ -521,8 +529,10 @@
end function file_exist
+
!#######################################################################
+
function get_unit () result (iunit)
integer :: i, iunit
@@ -546,8 +556,10 @@
end function get_unit
+
!#######################################################################
+
subroutine dump_unit_attributes(iunit)
!--------------------------------------------------------------------------------
! subroutine dump_unit_attributes(iunit)
@@ -558,7 +570,9 @@
integer, intent(in) :: iunit
logical :: exists, connected, named_file
- character(len=129) :: file_name, srname, str1
+ character(len=256) :: file_name
+ character(len=512) :: str1
+ character(len=32) :: srname
character(len=32) :: ynu ! YES, NO, UNDEFINED ... among others
integer :: ios, reclen, nextrecnum
@@ -675,8 +689,10 @@
end subroutine dump_unit_attributes
+
!#######################################################################
+
subroutine error_mesg (routine, message, level)
! ------------------------------------
@@ -711,8 +727,10 @@
end subroutine error_mesg
+
!#######################################################################
+
subroutine error_handler(level, routine, text, src, rev, rdate, aut, text2, text3 )
!----------------------------------------------------------------------
! subroutine error_handler(level, routine, text, src, rev, rdate, aut , text2, text3)
@@ -721,10 +739,10 @@
implicit none
integer, intent(in) :: level
-character(len = *), intent(in) :: routine, text
-character(len = *), intent(in), optional :: src, rev, rdate, aut, text2, text3
+character(len=*), intent(in) :: routine, text
+character(len=*), intent(in), optional :: src, rev, rdate, aut, text2, text3
-character(len = 8) :: taskstr
+character(len=8) :: taskstr
if ( .not. module_initialized ) call initialize_utilities
@@ -877,8 +895,10 @@
end subroutine error_handler
+
!#######################################################################
+
function open_file (fname, form, action) result (iunit)
character(len=*), intent(in) :: fname
@@ -985,33 +1005,35 @@
end function open_file
+
!#######################################################################
+
subroutine print_version_number (iunit, routine, version)
! *** prints routine name and version number to a log file ***
!
! in: iunit = unit number to direct output
-! routine = routine name (character, max len = 20)
-! version = version name or number (character, max len = 8)
+! routine = routine name (character, max len=20)
+! version = version name or number (character, max len=8)
integer, intent(in) :: iunit
character(len=*), intent(in) :: routine, version
integer :: n
- character(len=20) :: name
+ character(len=20) :: myname
character(len=8) :: vers
if ( .not. module_initialized ) call initialize_utilities
if ( .not. do_output_flag) return
- n = min(len(routine),20); name = adjustl(routine(1:n))
- n = min(len(version), 8); vers = adjustl(version(1:n))
+ n = min(len(routine),20); myname = adjustl(routine(1:n))
+ n = min(len(version), 8); vers = adjustl(version(1:n))
if (iunit > 0) then
- write (iunit,10) name, vers
+ write (iunit,10) myname, vers
else
- write (*,10) name, vers
+ write (*,10) myname, vers
endif
10 format (/,60('-'), &
@@ -1023,8 +1045,10 @@
end subroutine print_version_number
+
!#######################################################################
+
subroutine write_time (unit, label, string1, string2, string3, tz, brief)
! *** Write the current time to a log file or standard output ***
@@ -1105,8 +1129,10 @@
end subroutine write_time
+
!#######################################################################
+
subroutine set_output (doflag)
! *** set whether output is written to a log file or simply ignored ***
@@ -1128,6 +1154,7 @@
!#######################################################################
+
function do_output ()
! *** return whether output should be written from this task ***
@@ -1141,8 +1168,10 @@
end function do_output
+
!#######################################################################
+
subroutine set_nml_output (nmlstring)
! *** set whether nml output is written to stdout file or only nml file
@@ -1186,6 +1215,7 @@
!#######################################################################
+
function do_nml_file ()
! *** return whether nml should be written to nml file
@@ -1203,8 +1233,10 @@
end function do_nml_file
+
!#######################################################################
+
function do_nml_term ()
! *** return whether nml should be written to terminal
@@ -1222,6 +1254,7 @@
end function do_nml_term
+
!#######################################################################
@@ -1269,10 +1302,10 @@
end subroutine close_file
+
!#######################################################################
-
subroutine find_namelist_in_file(namelist_file_name, nml_name, iunit, &
write_to_logfile_in)
!-----------------------------------------------------------------------
@@ -1284,14 +1317,14 @@
! returns true. Otherwise, error message and terminates
!
-character(len = *), intent(in) :: namelist_file_name
-character(len = *), intent(in) :: nml_name
+character(len=*), intent(in) :: namelist_file_name
+character(len=*), intent(in) :: nml_name
integer, intent(out) :: iunit
logical, intent(in), optional :: write_to_logfile_in
-character(len = 169) :: nml_string, test_string, string1
-integer :: io
-logical :: write_to_logfile
+character(len=256) :: nml_string, test_string, string1
+integer :: io
+logical :: write_to_logfile
! Decide if there is a logfile or not
@@ -1365,7 +1398,6 @@
!#######################################################################
-
subroutine check_namelist_read(iunit, iostat_in, nml_name, &
write_to_logfile_in)
!-----------------------------------------------------------------------
@@ -1375,10 +1407,10 @@
!
integer, intent(in) :: iunit, iostat_in
-character(len = *), intent(in) :: nml_name
+character(len=*), intent(in) :: nml_name
logical, intent(in), optional :: write_to_logfile_in
-character(len=159) :: nml_string
+character(len=256) :: nml_string
integer :: io
logical :: write_to_logfile
@@ -1438,14 +1470,16 @@
end subroutine check_namelist_read
+
!#######################################################################
+
subroutine nc_check(istatus, subr_name, context)
integer, intent (in) :: istatus
character(len=*), intent(in) :: subr_name
character(len=*), intent(in), optional :: context
- character(len=129) :: error_msg
+ character(len=512) :: error_msg
! if no error, nothing to do here. we are done.
if( istatus == nf90_noerr) return
@@ -1470,6 +1504,7 @@
!#######################################################################
+
subroutine to_upper( string )
! Converts 'string' to uppercase
character(len=*), intent(INOUT) :: string
@@ -1486,8 +1521,10 @@
end subroutine to_upper
+
!#######################################################################
+
subroutine find_textfile_dims( fname, nlines, linelen )
! Determines the number of lines and maximum line length
! of the file. Sometimes you need to know this stuff.
@@ -1498,7 +1535,7 @@
integer :: i, maxlen, mylen, ios, funit
character(len=1024) :: oneline
-character(len=129) :: error_msg
+character(len=512) :: error_msg
! if there is no file, return -1 for both counts
if (.not. file_exist(fname)) then
@@ -1535,8 +1572,10 @@
end subroutine find_textfile_dims
+
!#######################################################################
+
subroutine file_to_text( fname, textblock )
!
! Reads a text file into a character variable.
@@ -1588,8 +1627,10 @@
end subroutine file_to_text
+
!#######################################################################
+
function get_next_filename( listname, index )
! Arguments are the name of a file which contains a list of filenames.
@@ -1597,7 +1638,7 @@
!
character(len=*), intent(in) :: listname
integer, intent(in) :: index
-character(len=128) :: get_next_filename
+character(len=256) :: get_next_filename
integer :: i, ios, funit
@@ -1621,7 +1662,7 @@
! check for length problems
if (len_trim(string) > len(get_next_filename)) then
call error_handler(E_ERR, 'get_next_filename', &
- 'maximum filename length of 128 exceeded', &
+ 'maximum filename length of 256 exceeded', &
source, revision, revdate)
endif
@@ -1630,8 +1671,10 @@
end function get_next_filename
+
!#######################################################################
+
function is_longitude_between (lon, minlon, maxlon, doradians, newlon)
! uniform way to treat longitude ranges, in degrees, on a globe.
@@ -1711,6 +1754,7 @@
!#######################################################################
+
function next_file(fname,ifile)
!----------------------------------------------------------------------
! The file name can take one of three forms:
@@ -1734,8 +1778,8 @@
integer, SAVE :: filenum = 0
integer, SAVE :: dir_prec = 0
-character(len=129), SAVE :: dir_base
-character(len=129), SAVE :: filename
+character(len=256), SAVE :: dir_base
+character(len=256), SAVE :: filename
character(len=129), SAVE :: dir_ext
integer :: slashindex, splitindex, i, strlen, ios
@@ -1834,6 +1878,7 @@
end function next_file
+
!#######################################################################
@@ -1845,7 +1890,7 @@
character(len=*), intent(in), optional :: fform
logical :: ascii_file_format
-character(len=129) :: lj_fform ! Left Justified version of optional argument
+character(len=len(fform)) :: lj_fform ! Left Justified version of optional argument
! Returns .true. for formatted/ascii file, .false. is unformatted/binary
! Defaults (if fform not specified) to formatted/ascii.
More information about the Dart-dev
mailing list