ESMF_TestFileCompare Function

public function ESMF_TestFileCompare(file1, file2, exclusionList)

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: file1
character(len=*), intent(in) :: file2
character(len=*), intent(in), optional :: exclusionList(:)

Return Value logical


Source Code

      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