[Dart-dev] [10339] DART: a collection of minor code changes to produce more correct
nancy at ucar.edu
nancy at ucar.edu
Mon Jun 6 16:26:29 MDT 2016
Revision: 10339
Author: nancy
Date: 2016-06-06 16:26:28 -0600 (Mon, 06 Jun 2016)
Log Message:
-----------
a collection of minor code changes to produce more correct
and hopefully more informative error messages when a dart
restart file is unable to be opened. specific changes are:
assim_model_mod.f90: update to open_restart_read() for better
error messages ('unable to find file' message is different from
'unable to open file' message is different from 'unable to read
a valid timestamp from the file'). now calls the open_file() and
close_file() routines from the utility mod.
utilities_mod.f90: added an optional last argument to the
open_file() function to allow the read error status value to
be passed back to the caller for further processing or to add
more context to the error messages. removed the code block
in this function which has been commented out since the first
CVS commit, revision 59, in 2002.
time_manager_mod.f90: read_time() now errors out not just when
the read() call has a non-zero status but also when the numeric
time values are illegal. since these are being read from a file
there are always 2 numbers so they must both be positive and
the seconds must be within range. this test can help identify
files which are corrupted or written on an architecture with
a different byte order. commented out the call to the
verbose dump_attributes() routine since the filename and
the read status code will be printed and should identify
the problem more succinctly. in set_time() moved the lines
that format up two error messages to inside the if() blocks
so they aren't executed until an error actually occurs.
Modified Paths:
--------------
DART/branches/trunk_sort_and_time/time_manager/time_manager_mod.f90
DART/trunk/assim_model/assim_model_mod.f90
DART/trunk/utilities/utilities_mod.f90
-------------- next part --------------
Modified: DART/branches/trunk_sort_and_time/time_manager/time_manager_mod.f90
===================================================================
--- DART/branches/trunk_sort_and_time/time_manager/time_manager_mod.f90 2016-06-06 19:38:45 UTC (rev 10338)
+++ DART/branches/trunk_sort_and_time/time_manager/time_manager_mod.f90 2016-06-06 22:26:28 UTC (rev 10339)
@@ -137,7 +137,7 @@
logical, save :: module_initialized = .false.
-character(len=129) :: errstring
+character(len=512) :: errstring, errstring2
!======================================================================
@@ -165,9 +165,10 @@
! Negative time offset is illegal
-write(errstring,*)'seconds, days are ',seconds, days_in,' cannot be negative'
-if(seconds < 0 .or. days_in < 0) &
+if(seconds < 0 .or. days_in < 0) then
+ write(errstring,*)'seconds, days are ',seconds, days_in,' cannot be negative'
call error_handler(E_ERR,'set_time',errstring,source,revision,revdate)
+endif
! Make sure seconds greater than a day are fixed up.
! Extra parens to force the divide before the multiply are REQUIRED
@@ -178,9 +179,10 @@
! Check for overflow on days before doing operation
-write(errstring,*)'seconds is ',seconds,' overflowing conversion to days'
-if(seconds / (60*60*24) >= huge(days_in) - days_in) &
+if(seconds / (60*60*24) >= huge(days_in) - days_in) then
+ write(errstring,*)'seconds is ',seconds,' overflowing conversion to days'
call error_handler(E_ERR,'set_time',errstring,source,revision,revdate)
+endif
set_time%days = days_in + seconds / (60*60*24)
@@ -3008,6 +3010,16 @@
function read_time(file_unit, form, ios_out)
!--------------------------------------------------------------------------------
!
+! read a 2-integer timestamp from an already opened file.
+! 'form', if specified, must indicate a formatted or unformatted file
+! so the correct read() call will be used.
+! if 'ios_out' is present this routine will not call the error
+! handler even on error - the calling code must check the ios_out
+! return code. if non-zero, it will be the return code from a
+! failed read() call. if zero, then the time derived type has
+! the time values. they should be checked - if the values read were
+! out of legal range they will both have been set to MISSING_I
+! (the integer missing value).
integer, intent(in) :: file_unit
character(len=*), intent(in), optional :: form
@@ -3016,7 +3028,7 @@
type(time_type) :: read_time
integer :: secs, days, ios
-character(len=128) :: filename
+character(len=256) :: filename
logical :: is_named
integer :: rc
@@ -3028,10 +3040,19 @@
read(file_unit, iostat=ios) secs, days
endif
-if ( ios /= 0 ) then
+! we always write timestamps as 2 ints: secs, days. test for both
+! an error from the read call or garbage values for the integers.
+! with a binary file we might get a good read return but the
+! values could be garbage. testing here gives us a better shot
+! at generating a useful error message.
- ! If ios_out argument is present, just return a non-zero ios
+if ( ios /= 0 .or. secs < 0 .or. days < 0 .or. secs > 86400) then
+
+ ! If ios_out argument is present return to the caller.
+ ! Note that this could be 0 now if the values being read are
+ ! garbage. The caller needs to sort this out.
if(present(ios_out)) then
+ read_time = set_time_missing()
ios_out = ios
return
endif
@@ -3042,9 +3063,14 @@
if ((rc /= 0) .or. (.not. is_named)) filename = 'unknown'
! Otherwise, read error is fatal, print message and stop
- call dump_unit_attributes(file_unit) ! TJH DEBUG statement
- write(errstring,*)'read returned status ', ios, 'from input file ', trim(filename)
- call error_handler(E_ERR,'read_time',errstring,source,revision,revdate)
+ !call dump_unit_attributes(file_unit) ! TJH DEBUG statement
+ write(errstring,*)'read returned status ', ios, ' from input file ', trim(filename)
+ if (ios /= 0) then
+ call error_handler(E_ERR,'read_time',errstring,source,revision,revdate)
+ else
+ write(errstring2,*)'seconds/days read was ', secs, days
+ call error_handler(E_ERR,'read_time',errstring,source,revision,revdate,text2=errstring2)
+ endif
else
read_time = set_time(secs, days)
if(present(ios_out)) ios_out = 0
Modified: DART/trunk/assim_model/assim_model_mod.f90
===================================================================
--- DART/trunk/assim_model/assim_model_mod.f90 2016-06-06 19:38:45 UTC (rev 10338)
+++ DART/trunk/assim_model/assim_model_mod.f90 2016-06-06 22:26:28 UTC (rev 10339)
@@ -21,7 +21,7 @@
dump_unit_attributes, find_namelist_in_file, &
check_namelist_read, nc_check, do_nml_file, do_nml_term, &
find_textfile_dims, file_to_text, set_output, &
- ascii_file_format, set_output
+ ascii_file_format, set_output, file_exist, open_file, close_file
use model_mod, only : get_model_size, static_init_model, get_state_meta_data, &
get_model_time_step, model_interpolate, init_conditions, &
init_time, adv_1step, end_model, nc_write_model_atts, &
@@ -958,30 +958,18 @@
integer :: open_restart_read
character(len = *), intent(in) :: file_name
-integer :: ios, ios_out
-!!logical :: old_output_state
+integer :: ios
type(time_type) :: temp_time
-character(len=64) :: string2
+character(len=256) :: string2
if ( .not. module_initialized ) call static_init_assim_model()
-! DEBUG -- if enabled, every task will print out as it opens the
-! restart files. If questions about missing restart files, first start
-! by commenting in only the timestamp line. If still concerns, then
-! go ahead and comment in all the lines.
-!!old_output_state = do_output()
-!!call set_output(.true.)
-!call timestamp("open_restart", "opening restart file "//trim(file_name), pos='')
-!!call set_output(old_output_state)
-!END DEBUG
+if (.not. file_exist(file_name)) then
+ write(msgstring, *) 'Restart file "'//trim(file_name)//'" not found'
+ call error_handler(E_ERR, 'open_restart_read', msgstring, &
+ source, revision, revdate)
+endif
-! if you want to document which file(s) are being opened before
-! trying the open (e.g. in case the fortran runtime library intercepts
-! the error and does not return to let us print out the name) then
-! comment this in and you can see what files are being opened.
-!write(msgstring, *) 'Opening restart file ',trim(adjustl(file_name))
-!call error_handler(E_MSG,'open_restart_read',msgstring,source,revision,revdate)
-
! WARNING: Absoft Pro Fortran 9.0, on a power-pc mac, is convinced
! that certain binary files are, in fact, ascii, because the read_time
! call is returning what seems like a good time even though it should
@@ -995,52 +983,48 @@
! Autodetect format of restart file when opening
! Know that the first thing in here has to be a time, so try to read it.
! If it fails with one format, try the other. If it fails with both, punt.
-open_restart_read = get_unit()
+
read_format = 'formatted'
-open(unit = open_restart_read, &
- file = trim(file_name), &
- form = read_format, &
- action = 'read', &
- status = 'old', &
- iostat = ios)
-! An opening error means something is wrong with the file, error and stop
-if(ios /= 0) goto 11
-temp_time = read_time(open_restart_read, read_format, ios_out)
-if(ios_out == 0) then
+open_restart_read = open_file(file_name, read_format, 'read', return_rc=ios)
+if (ios /= 0) then
+ write(msgstring, *) 'Unable to open restart file "'//trim(file_name)//'"'
+ write(string2, *) 'Error code was ', ios
+ call error_handler(E_ERR, 'open_restart_read', msgstring, &
+ source, revision, revdate, text2=string2)
+endif
+
+! check read() iostatus code and return now if it succeeds.
+temp_time = read_time(open_restart_read, read_format, ios)
+if(ios == 0) then
! It appears to be formatted, proceed
rewind open_restart_read
return
endif
-! Next, try to see if an unformatted read works instead
-close(open_restart_read)
+! No, so try an unformatted read instead
+call close_file(open_restart_read)
-open_restart_read = get_unit()
read_format = 'unformatted'
-open(unit = open_restart_read, &
- file = trim(file_name), &
- form = read_format, &
- action = 'read', &
- status = 'old', &
- iostat = ios)
-! An opening error means something is wrong with the file, error and stop
-if(ios /= 0) goto 11
-rewind open_restart_read
-temp_time = read_time(open_restart_read, read_format, ios_out)
-if(ios_out == 0) then
- ! It appears to be unformatted, proceed
- rewind open_restart_read
- return
+open_restart_read = open_file(file_name, read_format, 'read', return_rc=ios)
+if (ios /= 0) then
+ write(msgstring, *) 'Unable to open restart file "'//trim(file_name)//'"'
+ write(string2, *) 'Error code was ', ios
+ call error_handler(E_ERR, 'open_restart_read', msgstring, &
+ source, revision, revdate, text2=string2)
endif
-! Otherwise, neither format works. Have a fatal error.
-11 continue
+! we caught the formatted read error, but this time for an
+! unformatted read it might not fail even with bad values,
+! so let read_time do the error handling. it won't return if
+! the read() fails or if the values are out of range.
+temp_time = read_time(open_restart_read, read_format)
-write(msgstring, *) 'Problem opening file ',trim(file_name)
-write( string2 , *) 'OPEN status was ',ios
-call error_handler(E_ERR, 'open_restart_read', msgstring, &
- source, revision, revdate, text2=string2)
+! if read_time returns then we seems to have an unformatted
+! file. proceed.
+rewind open_restart_read
+return
+
end function open_restart_read
Modified: DART/trunk/utilities/utilities_mod.f90
===================================================================
--- DART/trunk/utilities/utilities_mod.f90 2016-06-06 19:38:45 UTC (rev 10338)
+++ DART/trunk/utilities/utilities_mod.f90 2016-06-06 22:26:28 UTC (rev 10339)
@@ -900,10 +900,11 @@
!#######################################################################
- function open_file (fname, form, action) result (iunit)
+ function open_file (fname, form, action, return_rc) result (iunit)
- character(len=*), intent(in) :: fname
- character(len=*), intent(in), optional :: form, action
+ character(len=*), intent(in) :: fname
+ character(len=*), intent(in) , optional :: form, action
+ integer, intent(out), optional :: return_rc
integer :: iunit
integer :: nc, rc
@@ -912,96 +913,86 @@
character(len=6) :: pos
character(len=9) :: act
character(len=7) :: stat
+ character(len=32) :: msgstring1
if ( .not. module_initialized ) call initialize_utilities
inquire (file=trim(fname), opened=open, number=iunit, &
form=format, iostat=rc)
+ ! if already open, return now
if (open) then
-! ---------- check format ??? ---------
-! ---- (skip this and let fortran i/o catch bug) -----
+ if (present(return_rc)) return_rc = rc
+ return
+ endif
- ! if (present(form)) then
- ! nc = min(11,len(form))
- ! if (format == 'UNFORMATTED') then
- ! if (form(1:nc) /= 'unformatted' .and. &
- ! form(1:nc) /= 'UNFORMATTED') &
- ! call error_mesg ('open_file in utilities_mod', &
- ! 'invalid form argument', 2)
- ! else if (format(1:9) == 'FORMATTED') then
- ! if (form(1:nc) /= 'formatted' .and. &
- ! form(1:nc) /= 'FORMATTED') &
- ! call error_mesg ('open_file in utilities_mod', &
- ! 'invalid form argument', 2)
- ! else
- ! call error_mesg ('open_file in utilities_mod', &
- ! 'unexpected format returned by inquire', 2)
- ! endif
- ! endif
+ ! not already open, so open it.
- else
-! ---------- open file ----------
+ ! this code used to only set the form and position, not the action.
+ ! not specifying 'read' meant that many compilers would create an
+ ! empty file instead of returning a read error. this leads to lots
+ ! of confusion. add an explicit action here. if the incoming argument
+ ! is read, make sure the open() call passes that in as an action.
- ! this code used to only set the form and position, not the action.
- ! not specifying 'read' meant that many compilers would create an
- ! empty file instead of returning a read error. this leads to lots
- ! of confusion. add an explicit action here. if the incoming argument
- ! is read, make sure the open() call passes that in as an action.
+ format = 'formatted'
+ act = 'readwrite'
+ pos = 'rewind'
+ stat = 'unknown'
- format = 'formatted'
- act = 'readwrite'
- pos = 'rewind'
- stat = 'unknown'
+ if (present(form)) then
+ nc = min(len(format),len(form))
+ format(1:nc) = form(1:nc)
+ endif
- if (present(form)) then
- nc = min(len(format),len(form))
- format(1:nc) = form(1:nc)
- endif
+ if (present(action)) then
+ select case(action)
- if (present(action)) then
- select case(action)
+ case ('read', 'READ')
+ ! open existing file. fail if not found. read from start.
+ act = 'read'
+ stat = 'old'
+ pos = 'rewind'
- case ('read', 'READ')
- ! open existing file. fail if not found. read from start.
- act = 'read'
- stat = 'old'
- pos = 'rewind'
+ case ('write', 'WRITE')
+ ! create new file/replace existing file. write at start.
+ act = 'write'
+ stat = 'replace'
+ pos = 'rewind'
- case ('write', 'WRITE')
- ! create new file/replace existing file. write at start.
- act = 'write'
- stat = 'replace'
- pos = 'rewind'
+ case ('append', 'APPEND')
+ ! create new/open existing file. write at end.
+ act = 'readwrite'
+ stat = 'unknown'
+ pos = 'append'
- case ('append', 'APPEND')
- ! create new/open existing file. write at end.
- act = 'readwrite'
- stat = 'unknown'
- pos = 'append'
+ case default
+ ! leave defaults specified above, currently
+ ! create new/open existing file. write at start.
+ !print *, 'action specified, and is ', action
+ end select
+ endif
- case default
- ! leave defaults specified above, currently
- ! create new/open existing file. write at start.
- !print *, 'action specified, and is ', action
- end select
- endif
+ iunit = get_unit()
- iunit = get_unit()
+ if (format == 'formatted' .or. format == 'FORMATTED') then
+ open (iunit, file=trim(fname), form=format, &
+ position=pos, delim='apostrophe', &
+ action=act, status=stat, iostat=rc)
+ else
+ open (iunit, file=trim(fname), form=format, &
+ position=pos, action=act, status=stat, iostat=rc)
+ endif
- if (format == 'formatted' .or. format == 'FORMATTED') then
- open (iunit, file=trim(fname), form=format, &
- position=pos, delim='apostrophe', &
- action=act, status=stat, iostat=rc)
- else
- open (iunit, file=trim(fname), form=format, &
- position=pos, action=act, status=stat, iostat=rc)
- endif
+ if (present(return_rc)) then
+ return_rc = rc
+ return
+ endif
- if (rc /= 0) then
- write(msgstring,*)'Cannot open file "'//trim(fname)//'" for '//trim(act)
- call error_handler(E_ERR, 'open_file: ', msgstring, source, revision, revdate)
- endif
+ if (rc /= 0) then
+ write(msgstring,*)'Cannot open file "'//trim(fname)//'" for '//trim(act)
+ write(msgstring1,*)'Error code was ', rc
+ call error_handler(E_ERR, 'open_file: ', msgstring, source, revision, revdate, &
+ text2=msgstring1)
endif
end function open_file
More information about the Dart-dev
mailing list