-- 作者: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
|