subroutine putios (name,ier)
  use gsys_interfaces, except_this=>putios
  !---------------------------------------------------------------------
  ! @ public
  ! Print system message corresponding to IO error code IER
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: name  ! Facility name
  integer(kind=4),  intent(in) :: ier   ! 32-bit system message code
  ! Local
  character(len=256) :: msg
  !
  call gag_iostat(msg,ier)
  write(6,'(A,A)') name,trim(msg)
end subroutine putios
!
subroutine putmsg (name,ier)
  !---------------------------------------------------------------------
  ! @ private
  ! UTIL  Internal routine
  !       Print system message corresponding to code IER on SYS$OUTPUT.
  !---------------------------------------------------------------------
  character(len=*), intent(in) :: name  ! Facility name
  integer(kind=4),  intent(in) :: ier   ! 32-bit system message code
  !
  write(6,'(A,A,I6)') name,'System Error number ',ier
end subroutine putmsg
!
subroutine gag_iostat (msg,ier)
  use gsys_interfaces, except_this=>gag_iostat
  !---------------------------------------------------------------------
  ! @ public
  ! Return system message corresponding to IO error code IER
  !---------------------------------------------------------------------
  character(len=*), intent(out) :: msg  ! Returned message
  integer(kind=4),  intent(in)  :: ier  ! 32-bit system message code
  !
#if defined(GFORTRAN)
  call gfc_iostat(msg,ier)
#elif defined(WIN32)
  call win32_iostat(msg,ier)
#elif defined(IFORT)
  call ifort_iostat(msg,ier)
#else
  write(msg,'(A,I6)') 'I/O error number ',ier
#endif
end subroutine gag_iostat
!
subroutine win32_iostat (msg,ier)
  !---------------------------------------------------------------------
  ! @ private
  ! Get system message corresponding to IO error code IER
  !     Version for WIN32 Dec/Compaq compiler
  !---------------------------------------------------------------------
  character(len=*), intent(out) :: msg  ! Returned message
  integer(kind=4),  intent(in)  :: ier  ! 32-bit system message code
  ! Local
  character(len=48) :: io00(22:68)
  !
  data io00                                          &
    /'Input record too long '                        &  ! 22
    ,'Backspace error'                               &  ! 23
    ,'End-of-file during read'                       &  ! 24
    ,'Record number out of range '                   &  ! 25
    ,'OPEN required '                                &  ! 26
    ,'Too many record in I/O statement'              &  ! 27
    ,'CLOSE error'                                   &  ! 28
    ,'File not found'                                &  ! 29
    ,'Open failure'                                  &  ! 30
    ,'Mixed file access modes'                       &  ! 31
    ,'Invalid logical unit number'                   &  ! 32
    ,'ENDFILE error'                                 &  ! 33
    ,'Unit already opened'                           &  ! 34
    ,'Segmented record format error'                 &  ! 35
    ,'Attempt to access non-existent record'         &  ! 36
    ,'Inconsistent record length'                    &  ! 37
    ,'Error during write'                            &  ! 38
    ,'Error during read'                             &  ! 39
    ,'Recursive I/O operation'                       &  ! 40
    ,'Insufficient virtual memory'                   &  ! 41
    ,'No such device'                                &  ! 42
    ,'File name specification error'                 &  ! 43
    ,'Inconsistent record type'                      &  ! 44
    ,'Keyword value error in OPEN statement'         &  ! 45
    ,'Inconsistent OPEN/CLOSE parameters'            &  ! 46
    ,'Write to READONLY file'                        &  ! 47
    ,'Invalid argument to Fortran Run-Time Library'  &  ! 48
    ,' '                                             &
    ,' '                                             &
    ,'Inconsistent file organization',' '            &  ! 51
    ,'No current record',' '                         &  ! 53
    ,'DELETE error',' '                              &  ! 55
    ,'FIND error'                                    &  ! 57
    ,'Format syntax error at or near XX'             &  ! 58
    ,'List directed I/O syntax error'                &  ! 59
    ,'Infinite format loop'                          &  ! 60
    ,'Format/variable-type mismatch'                 &  ! 61
    ,'Syntax error in format'                        &  ! 62
    ,'Output conversion error'                       &  ! 63
    ,'Input conversion error'                        &  ! 64
    ,'Floating invalid'                              &  ! 65
    ,'Output statement overflows record'             &  ! 66
    ,'Input statement requires too much data'        &  ! 67
    ,'Variable format expression value error'/          ! 68
  ! ,' '
  ! ,'Integer overflow'                                 ! 70
  ! ,'Integer divide by zero'
  ! ,'
  !
  if (ier.lt.22 .or. ier.gt.68) then
    write(msg,'(A,I6)') 'I/O error number ',ier
  else
    msg = io00(ier)
  endif
  !
end subroutine win32_iostat
!
subroutine g95_iostat (msg,ier)
  !---------------------------------------------------------------------
  ! @ private
  ! Get system message corresponding to IO error code IER
  !     Version for G95 Gnu compiler.
  !---------------------------------------------------------------------
  character(len=*), intent(out) :: msg  ! Returned message
  integer(kind=4),  intent(in)  :: ier  ! 32-bit system message code
  ! Local
  character(len=40) :: errmsg
  character(len=40) :: io200(15)
  data io200/                               &
    'Conflicting statement options',        &
    'Bad statement option',                 &
    'Missing statement option',             &
    'File already opened in another unit',  &
    'Unattached unit',                      &
    'FORMAT error',                         &
    'Incorrect ACTION specified',           &
    'Read past ENDFILE record',             &
    'Corrupt unformatted sequential file',  &
    'Bad value during read',                &
    'Numeric overflow on read',             &
    'Out of memory',                        &
    'Array already allocated',              &
    'Deallocated a bad pointer',            &
    'Bad record read on input'/
  !
  if (ier.eq.-2) then
    msg = 'End of record'
  elseif  (ier.eq.-1) then
    msg = 'End of file'
  elseif  (ier.lt.200) then
    call gag_errno(ier,errmsg)
    write(msg,'(A,I4,A)')  trim(errmsg)//' (O/S errno # ',ier,')'
  elseif  (ier.le.214) then
    msg = io200(ier-200+1)
  else
    write(msg,'(A,I5)')  'Unknown error code ',ier
  endif
  !
end subroutine g95_iostat
!
subroutine gfc_iostat (msg,ier)
  !---------------------------------------------------------------------
  ! @ private
  ! Get system message corresponding to IO error code IER
  !     Version for GFortran Gnu compiler.
  !---------------------------------------------------------------------
  character(len=*), intent(out) :: msg  ! Returned message
  integer(kind=4),  intent(in)  :: ier  ! 32-bit system message code
  ! Local
  character(len=48) :: errmsg,io5000(17)
  data io5000/                                       &
    'Conflicting statement options',                 &  ! 5001
    'Bad statement option',                          &  ! 5002
    'Missing statement option',                      &  ! 5003
    'File already opened in another unit',           &  ! 5004
    'Unattached unit',                               &  ! 5005
    'FORMAT error',                                  &  ! 5006
    'Incorrect ACTION specified',                    &  ! 5007
    'Read past ENDFILE record',                      &  ! 5008
    'Corrupt unformatted sequential file',           &  ! 5009
    'Bad value during read',                         &  ! 5010
    'Numeric overflow on read',                      &  ! 5011
    'Internal error in run-time library',            &  ! 5012
    'Internal unit I/O error',                       &  ! 5013
    '? (LIBERROR_ALLOCATION)',                       &  ! 5014 ?
    'Write exceeds length of DIRECT access record',  &  ! 5015
    'I/O past end of record on unformatted file',    &  ! 5016
    'Unformatted file structure has been corrupted' /   ! 5017
  !
  select case (ier)
  case(-2)
    msg = 'End of record'
    !
  case(-1)
    msg = 'End of file'
    !
  case(5001:5017)
    msg = io5000(ier-5000)
    !
  case default
    call gag_errno(ier,errmsg)
    write(msg,'(A,I4,A)')  trim(errmsg)//' (O/S errno # ',ier,')'
    !
  end select
  !
end subroutine gfc_iostat
!
subroutine ifort_iostat(msg,ier)
  !---------------------------------------------------------------------
  ! @ private
  ! Get system message corresponding to IO error code IER
  !     Version for Intel Fortran compiler.
  !---------------------------------------------------------------------
  character(len=*), intent(out) :: msg  ! Returned message
  integer(kind=4),  intent(in)  :: ier  ! 32-bit system message code
  !
  select case (ier)
  case(-2)
    msg = 'End of record'
  case(-1)
    msg = 'End of file'
  case(1)
    msg = 'Not a Fortran-specific error'
  case(8)
    msg = 'Internal consistency check failure'
  case(9)
    msg = 'Permission to access file denied'
  case(10)
    msg = 'Cannot overwrite existing file'
  case(11)
    msg = 'Unit not connected'
  case(17)
    msg = 'Syntax error in NAMELIST input'
  case(18)
    msg = 'Too many values for NAMELIST variable'
  case(19)
    msg = 'Invalid reference to variable in NAMELIST input'
  case(20)
    msg = 'REWIND error'
  case(21)
    msg = 'Duplicate file specifications'
  case(22)
    msg = 'Input record too long'
  case(23)
    msg = 'BACKSPACE error'
  case(24)
    msg = 'End-of-file during read'
  case(25)
    msg = 'Record number outside range'
  case(26)
    msg = 'OPEN or DEFINE FILE required'
  case(27)
    msg = 'Too many records in I/O statement'
  case(28)
    msg = 'CLOSE error'
  case(29)
    msg = 'File not found'
  case(30)
    msg = 'Open failure'
  case(31)
    msg = 'Mixed file access modes'
  case(32)
    msg = 'Invalid logical unit number'
  case(33)
    msg = 'ENDFILE error'
  case(34)
    msg = 'Unit already open'
  case(35)
    msg = 'Segmented record format error'
  case(36)
    msg = 'Attempt to access non-existent record'
  case(37)
    msg = 'Inconsistent record length'
  case(38)
    msg = 'Error during write'
  case(39)
    msg = 'Error during read'
  case(40)
    msg = 'Recursive I/O operation'
  case(41)
    msg = 'Insufficient virtual memory'
  case(42)
    msg = 'No such device'
  case(43)
    msg = 'File name specification error'
  case(44)
    msg = 'Inconsistent record type'
  case(45)
    msg = 'Keyword value error in OPEN statement'
  case(46)
    msg = 'Inconsistent OPEN/CLOSE parameters'
  case(47)
    msg = 'Write to READONLY file'
  case(48)
    msg = 'Invalid argument to Fortran Run-Time Library'
  case(51)
    msg = 'Inconsistent file organization'
  case(53)
    msg = 'No current record'
  case(55)
    msg = 'DELETE error'
  case(57)
    msg = 'FIND error'
  case(58)
    msg = 'Format syntax error at or near xx'
  case(59)
    msg = 'List-directed I/O syntax error'
  case(60)
    msg = 'Infinite format loop'
  case(61)
    msg = 'Format/variable-type mismatch'
  case(62)
    msg = 'Syntax error in format'
  case(63)
    msg = 'Output conversion error'
  case(64)
    msg = 'Input conversion error'
  case(65)
    msg = 'Floating invalid'
  case(66)
    msg = 'Output statement overflows record'
  case(67)
    msg = 'Input statement requires too much data'
  case(68)
    msg = 'Variable format expression value error'
  case(70)
    msg = 'Integer overflow'
  case(71)
    msg = 'Integer divide by zero'
  case(72)
    msg = 'Floating overflow'
  case(73)
    msg = 'Floating divide by zero'
  case(74)
    msg = 'Floating underflow'
  case(75)
    msg = 'Floating point exception'
  case(77)
    msg = 'Subscript out of range'
  case(78)
    msg = 'Process killed'
  case(79)
    msg = 'Process quit'
  case(90)
    msg = 'INQUIRE of internal unit-number is always an error (unit identifies a file)'
  case(91)
    msg = 'INQUIRE of internal unit-number is always an error (unit does not identify a file)'
  case(95)
    msg = 'Floating-point conversion failed'
  case(96)
    msg = 'F_UFMTENDIAN environment variable was ignored: erroneous syntax'
  case(98)
    msg = 'Cannot allocate memory for the file buffer - out of memory'
  case(104)
    msg = 'Incorrect "XXXXX=" specifier value for connected file'
  case(106)
    msg = 'FORT_BLOCKSIZE environment variable has erroneous syntax'
  case(107)
    msg = 'FORT_BUFFERCOUNT environment variable has erroneous syntax'
  case(108)
    msg = 'Cannot stat file'
  case(109)
    msg = 'Stream data transfer statement is not allowed to an unopened unit'
  case(118)
    msg = 'The RECL= value in an OPEN statement exceeds the maximum allowed for the file''s record type'
  case(119)
    msg = 'The FORT_BUFFERING_THRESHOLD environment variable has erroneous syntax'
  case(120)
    msg = 'Operation requires seek ability'
  case(121)
    msg = 'Cannot access current working directory'
  case default
    write(msg,'(A,I5)')  'Unknown error code ',ier
  end select
  !
end subroutine ifort_iostat
!
function failed_allocate(rname,array,ier,error)
  use gbl_message
  use gsys_interfaces, except_this=>failed_allocate
  !-------------------------------------------------------------------
  ! @ public
  ! Check allocation status and display a message if error
  !-------------------------------------------------------------------
  logical :: failed_allocate  ! Function value on return
  character(len=*), intent(in)    :: rname  ! Calling routine name
  character(len=*), intent(in)    :: array  ! Name of allocated array
  integer(kind=4),  intent(in)    :: ier    ! Allocation status
  logical,          intent(inout) :: error  ! Logical error flag
  ! Local
  character(len=160) :: mess
  !
  if (ier.ne.0) then
    write(mess,'(a,i0,a)') 'Could not allocate memory for '//array//' (IER = ',ier,')'
    call gsys_message(seve%e,rname,mess)
    error = .true.
  endif
  failed_allocate = error
end function failed_allocate
