function ESMF_TestFileCompare(file1, file2, exclusionList)
! !RETURN VALUE:
logical :: ESMF_TestFileCompare
! !ARGUMENTS:
character(*), intent(in) :: file1 ! test file name
character(*), intent(in) :: file2 ! test file name
character(*), intent(in), optional :: exclusionList(:)
! !DESCRIPTION:
! Compares two files to see if they are identical.
!
! Restrictions:
! 1.) Only text files are supported
! 2.) On systems which do not support recursive I/O, this function
! should not be called from the I/O list of an I/O statement.
! 3.) On Windows, blank lines are ignored to avoid issues with cr/lfs.
!
! The arguments are:
! \begin{description}
! \item [file1]
! First of two files to be compared.
! \item [file2]
! Second of two files to be compared.
! \item [{[exclusionList]}]
! Character strings which, if any are present in text records being
! compared, will cause a comparison error to be bypassed. This is
! useful for records which might legitimately differ between the two
! files - such as a date or version string.
! \end{description}
!EOP
!-------------------------------------------------------------------------------
logical :: exclusions
integer :: i
integer :: ioerr1, ioerr2
integer :: localrc
character(1024) :: string1, string2
character(ESMF_MAXSTR) :: errmsg
integer :: unit1, unit2
ESMF_TestFileCompare = .false.
exclusions = present (exclusionList)
call ESMF_UtilIOUnitGet (unit=unit1, rc=localrc)
if (localrc /= ESMF_SUCCESS) then
call ESMF_LogWrite (msg='Can not obtain IO unit number', &
logmsgFlag=ESMF_LOGMSG_ERROR)
write (ESMF_UtilIOStderr,*) ESMF_METHOD, &
': Can not obtain IO unit number'
return
end if
open (unit1, file=file1, &
form='formatted', status='old', action='read', &
iostat=ioerr1)
if (ioerr1 /= 0) then
errmsg = 'Can not open file: ' // file1
call ESMF_LogWrite (msg=errmsg, logmsgFlag=ESMF_LOGMSG_ERROR)
write (ESMF_UtilIOStderr,*) ESMF_METHOD, ': ' // trim (errmsg)
return
end if
call ESMF_UtilIOUnitGet (unit=unit2, rc=localrc)
if (localrc /= ESMF_SUCCESS) then
call ESMF_LogWrite (msg='Can not obtain IO unit number', &
logmsgFlag=ESMF_LOGMSG_ERROR)
write (ESMF_UtilIOStderr,*) ESMF_METHOD, &
': Can not obtain IO unit number'
close (unit1)
return
end if
open (unit2, file=file2, &
form='formatted', status='old', action='read', &
iostat=ioerr2)
if (ioerr2 /= 0) then
errmsg = 'Can not open file: ' // file2
call ESMF_LogWrite (msg=errmsg, logmsgFlag=ESMF_LOGMSG_ERROR)
write (ESMF_UtilIOStderr,*) ESMF_METHOD, ': ' // trim (errmsg)
close (unit1)
return
end if
read_loop: &
do
do
read (unit1, '(a)', iostat=ioerr1) string1
if (ioerr1 /= 0) exit
! Ignore blank lines due to cr/lf vs newline issues
do, i=1, len (string1)
string1(i:i) = merge (string1(i:i), ' ', string1(i:i) /= achar (13))
end do
if (string1 /= ' ') exit
end do
do
read (unit2, '(a)', iostat=ioerr2) string2
if (ioerr2 /= 0) exit
! Ignore blank lines due to cr/lf vs newline issues
do, i=1, len (string2)
string2(i:i) = merge (string2(i:i), ' ', string2(i:i) /= achar (13))
end do
if (string2 /= ' ') exit
end do
if (ioerr1 /= ioerr2) then
! print *, ESMF_METHOD, ': read iostats differ:', ioerr1, ioerr2
exit
end if
select case (ioerr1)
case (:-1)
ESMF_TestFileCompare = .true.
exit
case (0)
if (string1 /= string2) then
if (exclusions) then
exclusion_loop: &
do, i=1, size (exclusionList)
if (index (string1, trim (exclusionList(i))) /= 0 .and. &
index (string2, trim (exclusionList(i))) /= 0) then
exit exclusion_loop
end if
end do exclusion_loop
if (i > size (exclusionList)) exit read_loop
else
#if 0
print *, ESMF_METHOD, ': comparison error:'
print *, ' string1 = >', trim (string1), '<'
print *, ' string2 = >', trim (string2), '<'
#endif
exit read_loop
end if
end if
case (1:)
write (errmsg, '(a,i4)') 'unknown iostat = ', ioerr1
call ESMF_LogWrite (msg=errmsg, logmsgFlag=ESMF_LOGMSG_ERROR)
print *, ESMF_METHOD, ': ', trim (errmsg)
exit
end select
end do read_loop
close (unit2)
close (unit1)
end function ESMF_TestFileCompare