以文本方式查看主题

-  Fortran中文网  (http://www.fortran.cn/bbs/index.asp)
--  Tecplot经验交流区  (http://www.fortran.cn/bbs/list.asp?boardid=9)
----  问题  (http://www.fortran.cn/bbs/dispbbs.asp?boardid=9&id=2733)

--  作者:liuqinglong
--  发布时间:2012/5/14 16:33:00

--  问题

麻烦哪位好心的高人指点一下,下面这段语言中用红色标出来的是什么意思呢??感激不尽呐~~~~

!--------------------------------------------------------------------------
! 1. Simple version
!--------------------------------------------------------------------------

subroutine message(type, string, status)

! Declarations
! ------------

  use messages, not_this => message

  implicit none

  interface
     function get_io_unit() result(unit)
       implicit none
       integer :: unit
     end function get_io_unit
  end interface


  integer,            intent(in) :: type
  character(len = *), intent(in) :: string
  integer,            optional   :: status

  integer                        :: stat
  integer                        :: idx
  character(len = 2024)          :: post, xstring
  character(len = 1024)          :: ropp_msg_mode

  integer                        :: logFileLrn
  character(len = *), parameter  :: logStrPrepend = \' ROPP \'


! Read ROPP_MSG_MODE environment variable to set msg_MODE level

  IF (.NOT. msg_MODE_READ) THEN
    CALL GETENV( "ROPP_MSG_MODE", ropp_msg_mode)
    SELECT CASE (TRIM(ropp_msg_mode))
    CASE ("QuietMode")
      msg_MODE = QuietMode
    CASE ("NormalMode")
      msg_MODE = NormalMode
    CASE ("VerboseMode")
      msg_MODE = VerboseMode
    END SELECT
    msg_MODE_READ = .true.
  ENDIF

! Exit status
! -----------

  if (present(status)) then
     stat = status
  else
     stat = -1
  endif

! Set names of program and routine
! --------------------------------

  if (len_trim(msg_program) == 0) then
     if (len_trim(msg_routine) == 0) then
        if (len_trim(msg_addinfo) == 0) then
           post = \':\'
        else
           post = \' (\' // trim(msg_addinfo) // \'):\'
        endif
     else
        if (len_trim(msg_addinfo) == 0) then
           post = \' (from \' // trim(msg_routine) // \'):\'
        else
           post = \' (from \' // trim(msg_routine) // \'/\' // &
                               trim(msg_addinfo) // \'):\'
        endif
     endif
  else
     if (len_trim(msg_routine) == 0) then
        if (len_trim(msg_addinfo) == 0) then
           post = \' (from \' // trim(msg_program) // \'):\'
        else
           post = \' (from \' // trim(msg_program) // \'/\' // &
                               trim(msg_addinfo) // \'):\'
        endif
     else
        if (len_trim(msg_addinfo) == 0) then
           post = \' (from \' // trim(msg_program) // \'/\' // &
                               trim(msg_routine) // \'):\'
        else
           post = \' (from \' // trim(msg_program) // \'/\' // &
                               trim(msg_routine) // \'/\' // &
                               trim(msg_addinfo) // \'):\'
        endif
     endif
  endif


  if (msg_logFile(1:1) /= \' \') then

     ! -----------------------------------
     ! Ignore control characters in string
     ! -----------------------------------

     xstring = string

     do
        idx = INDEX(trim(xstring),\'\\a\')
        if(idx == 0) exit
        xstring(idx:idx+1) = achar(32)
     enddo
     do
        idx = INDEX(trim(xstring),\'\\b\')
        if(idx == 0) exit
        xstring(idx:idx+1) = achar(32)
     enddo
     do
        idx = INDEX(trim(xstring),\'\\t\')
        if(idx == 0) exit
        xstring(idx:idx+1) = achar(32)
     enddo
     do
        idx = INDEX(trim(xstring),\'\\n\')
        if(idx == 0) exit
        xstring(idx:idx+1) = achar(32)
     enddo
     do
        idx = INDEX(trim(xstring), "\\\'")
        if(idx == 0) exit
        xstring(idx:idx+1) = achar(32)
     enddo
     do
        idx = INDEX(trim(xstring),\'\\"\')
        if(idx == 0) exit
        xstring(idx:idx+1) = achar(32)
     enddo
     do
        idx = INDEX(trim(xstring),\'\\\\\')
        if(idx == 0) exit
        xstring(idx:idx+1) = achar(32)
     enddo

     ! -----------------
     ! Log error message
     ! -----------------

     logFileLrn = get_io_unit()
     open(logFileLrn, file=msg_logFile, status=\'unknown\', position=\'append\')

     select case(type)
     case(msg_cont)
       IF (msg_MODE >= NormalMode)   &
          write(logFileLrn, \'(a)\') logStrPrepend // \'   \' // trim(xstring)
     case(msg_diag)
       IF (msg_MODE == VerboseMode)   &
          write(logFileLrn, \'(a)\') logStrPrepend // \'...\' // trim(post) // \'  \' // trim(xstring)
     case(msg_info)
          write(logFileLrn, \'(a)\') logStrPrepend // \'INFO\' // trim(post) // \'  \' // trim(xstring)
     case(msg_warn)
       IF (msg_MODE >= NormalMode) THEN
         write(logFileLrn, \'(a)\') logStrPrepend // \'WARNING\' // trim(post) // \'  \' // trim(xstring)
       ENDIF
     case(msg_error)
       IF (msg_MODE >= QuietMode) THEN
          write(logFileLrn, \'(a)\') logStrPrepend // \'ERROR\' // trim(post) // \'  \' // trim(xstring)
        ENDIF
      case(msg_fatal)
       IF (msg_MODE >= QuietMode) THEN
         write(logFileLrn, \'(a)\') logStrPrepend // \'FATAL ERROR\' // trim(post) // \'  \' // trim(xstring)
       ENDIF
       close(logFileLrn)
       call exit(stat)
     case(msg_noin)
       IF (msg_MODE >= NormalMode)   &
          write(logFileLrn, \'(a)\') logStrPrepend // trim(xstring)
     end select

     close(logFileLrn)
     return

  else

     ! -----------------------------------
     ! Handle control characters in string
     ! -----------------------------------

     xstring = string                      

     do
        idx = INDEX(trim(xstring),\'\\a\')
        if(idx == 0) exit
        xstring(idx:idx+1) = achar(07)
     enddo
     do
        idx = INDEX(trim(xstring),\'\\b\')
        if(idx == 0) exit
        xstring(idx:idx+1) = achar(08)
     enddo
     do
        idx = INDEX(trim(xstring),\'\\t\')
        if(idx == 0) exit
        xstring(idx:idx+1) = achar(09)
     enddo
     do
        idx = INDEX(trim(xstring),\'\\n\')
        if(idx == 0) exit
        xstring(idx:idx+1) = achar(10)
     enddo
     do
        idx = INDEX(trim(xstring), "\\\'")
        if(idx == 0) exit
        xstring(idx:idx+1) = achar(39)
     enddo
     do
        idx = INDEX(trim(xstring),\'\\"\')
        if(idx == 0) exit
        xstring(idx:idx+1) = achar(34)
     enddo
     do
        idx = INDEX(trim(xstring),\'\\\\\')
        if(idx == 0) exit
        xstring(idx:idx+1) = achar(92)
     enddo

     ! -------------------
     ! Print error message
     ! -------------------

     select case(type)
     case(msg_cont)
       IF (msg_MODE >= NormalMode)   &
          write(stdout, \'(a)\')  \'   \' // trim(xstring)
     case(msg_diag)
       IF (msg_MODE == VerboseMode)   &
          write(stdout, \'(a)\') \'...\' // trim(post) // \'  \' // trim(xstring)
     case(msg_info)
       IF (msg_MODE >= NormalMode)   &
          write(stdout, \'(a)\') \'INFO\' // trim(post) // \'  \' // trim(xstring)
     case(msg_warn)
       IF (msg_MODE >= NormalMode) THEN
         write(stderr, \'(a)\') \' \'
         write(stdout, \'(a)\') \'WARNING\' // trim(post) // \'  \' // trim(xstring)
       ENDIF
     case(msg_error)
       IF (msg_MODE >= QuietMode) THEN
          write(stderr, \'(a)\') \' \'
          write(stderr, \'(a)\') \'ERROR\' // trim(post) // \'  \' // trim(xstring)
        ENDIF
      case(msg_fatal)
       IF (msg_MODE >= QuietMode) THEN
         write(stderr, \'(a)\') \' \'
         write(stderr, \'(a)\') \'FATAL ERROR\' // trim(post) // \'  \' // trim(xstring)
         write(stderr, \'(a)\') \' \'
       ENDIF
       call exit(stat)
     case(msg_noin)
       IF (msg_MODE >= NormalMode)   &
          write(stdout, \'(a)\') trim(xstring)
     end select

   end if

end subroutine message



京ICP备05056801号