!
! ********************************************************************
! *                                                                  *
! *  Copyright 2001 Compaq Computer Corporation                      *
! *                                                                  *
! *  COMPAQ Registered in U.S. Patent and Trademark Office.          *
! *                                                                  *
! *  Confidential computer software. Valid license from Compaq or    *
! *  authorized sublicensor required for possession, use or copying. *
! *  Consistent with FAR 12.211 and 12.212, Commercial Computer      *
! *  Software, Computer Software Documentation, and Technical Data   *
! *  for Commercial Items are licensed to the U.S. Government under  *
! *  vendor's standard commercial license.                           *
! *                                                                  *
! ********************************************************************
!
!DEC$ IF .NOT. DEFINED(__DFPORT_INCLUDE)
MODULE DFPORT
!DEC$ ENDIF
!DEC$ OBJCOMMENT   LIB:"DFPORT.LIB"
!****
!**** Bessel functions
!****
interface
  real(4) function besj0(x)
!DEC$ ATTRIBUTES DEFAULT :: besj0
    real(4) x
  end function
  real(8) function dbesj0(x)
!DEC$ ATTRIBUTES DEFAULT :: dbesj0
    real(8) x
  end function
  real(4) function besj1(x)
!DEC$ ATTRIBUTES DEFAULT :: besj1
    real(4) x
  end function
  real(8) function dbesj1(x)
!DEC$ ATTRIBUTES DEFAULT :: dbesj1
    real(8) x
  end function
  real(4) function besjn(n,x)
!DEC$ ATTRIBUTES DEFAULT :: besjn
    integer(4) n
    real(4) x
  end function
  real(8) function dbesjn(n,x)
!DEC$ ATTRIBUTES DEFAULT :: dbesjn
    real(8) x
    integer(4) n
  end function
  real(4) function besy0(x)
!DEC$ ATTRIBUTES DEFAULT :: besy0
    real(4) x
  end function
  real(8) function dbesy0(x)
!DEC$ ATTRIBUTES DEFAULT :: dbesy0
    real(8) x
  end function
  real(4) function besy1(x)
!DEC$ ATTRIBUTES DEFAULT :: besy1
    real(4) x
  end function
  real(8) function dbesy1(x)
!DEC$ ATTRIBUTES DEFAULT :: dbesy1
    real(8) x
  end function
  real(4) function besyn(n,x)
!DEC$ ATTRIBUTES DEFAULT :: besyn
    integer(4) n
    real(4) x
  end function
  real(8) function dbesyn(n,x)
!DEC$ ATTRIBUTES DEFAULT :: dbesyn
    real(8) x
    integer(4) n
  end function
end interface
!****
!**** ierrno Error routines
!**** 
integer(4), parameter :: EPERM = 1      ! Insufficient Permission for Operation
integer(4), parameter :: ENOENT = 2     ! No Such File or Directory
integer(4), parameter :: ESRCH = 3      ! No Such Process
integer(4), parameter :: E2BIG = 7      ! Argument List Too Long
integer(4), parameter :: ENOEXEC = 8    ! File Is Not Executable
integer(4), parameter :: ENOMEM = 12    ! Not Enough Resources
integer(4), parameter :: EACCES = 13    ! Permission Denied
integer(4), parameter :: EXDEV = 18     ! Cross Device Link
integer(4), parameter :: ENOTDIR = 20   ! Not a Directory
integer(4), parameter :: EINVAL = 22    ! Invalid Argument
integer(4), parameter :: MAX_GERROR_LENGTH = 130 ! 1-001
interface
  integer(4) function ierrno()
!DEC$ ATTRIBUTES DEFAULT :: ierrno
  end function
  subroutine gerror( str )
!DEC$ ATTRIBUTES DEFAULT :: gerror
    character(len=*) str
  end subroutine
  subroutine perror( str )
!DEC$ ATTRIBUTES DEFAULT :: perror
    character(len=*) str 
  end subroutine
end interface
!****
!**** Date and Time routines
!****
interface idate  
  subroutine idate( iarray )
!DEC$ ATTRIBUTES DEFAULT :: idate
    !DEC$ ATTRIBUTES alias:'_IDATE@4' :: idate
    integer(4) iarray(3)
  end subroutine
  
  subroutine idate1( m, d, y )
!DEC$ ATTRIBUTES DEFAULT :: idate1
    !DEC$ ATTRIBUTES alias:'_IDATE@12' :: idate1
    integer(4) m, d, y 
  end subroutine
end interface
interface fdate
  character(len=24) function $$msportlib$fdate()
!DEC$ ATTRIBUTES DEFAULT :: $$msportlib$fdate
!DEC$ ATTRIBUTES alias:'_FDATE@8' :: $$msportlib$fdate
  end function
  subroutine $$msportlib$fdate$s( string )
!DEC$ ATTRIBUTES DEFAULT :: $$msportlib$fdate$s
!DEC$ ATTRIBUTES alias:'_FDATE@8' :: $$msportlib$fdate$s
    character(len=24) string
  end subroutine
end interface
interface
  character(len=8) function clock()
!DEC$ ATTRIBUTES DEFAULT :: clock
  end function
  real(8) function rtc()
!DEC$ ATTRIBUTES DEFAULT :: rtc
  end function
  real(4) function secnds( offset )
!DEC$ ATTRIBUTES DEFAULT :: secnds
    real(4) offset
  end function
  character(len=24) function ctime( stime )
!DEC$ ATTRIBUTES DEFAULT :: ctime
    integer(4) stime
  end function
  subroutine gmtime( stime, tarray )
!DEC$ ATTRIBUTES DEFAULT :: gmtime
    integer(4) stime, tarray(9)
  end subroutine
  subroutine ltime( stime, tarray )
!DEC$ ATTRIBUTES DEFAULT :: ltime
    integer(4) stime, tarray(9)
  end subroutine
  character(len=8) function jdate()
!DEC$ ATTRIBUTES DEFAULT :: jdate
  end function
  real(4) function dtime(tarray)
!DEC$ ATTRIBUTES DEFAULT :: dtime
    real(4) tarray(2)
  end function
  real(4) function etime(tarray)
!DEC$ ATTRIBUTES DEFAULT :: etime
    real(4) tarray(2)
  end function
  subroutine itime( iarray )
!DEC$ ATTRIBUTES DEFAULT :: itime
    integer(4) iarray(3)
  end subroutine
  real(8) function timef()
!DEC$ ATTRIBUTES DEFAULT :: timef
  end function
end interface
interface time
  integer(4) function $$msportlib$time()
!DEC$ ATTRIBUTES DEFAULT :: $$msportlib$time
!DEC$ ATTRIBUTES alias:'_TIME@0' :: $$msportlib$time
  end function
  subroutine $$msportlib$time$s( string )
!DEC$ ATTRIBUTES DEFAULT :: $$msportlib$time$s
!DEC$ ATTRIBUTES alias:'_TIME2@8' :: $$msportlib$time$s
    character(len=8) string
  end subroutine
end interface
interface date
  character(len=8) function $$msportlib$date()
!DEC$ ATTRIBUTES DEFAULT :: $$msportlib$date
!DEC$ ATTRIBUTES alias:'_DATE@8' :: $$msportlib$date
  end function
  subroutine $$msportlib$date$s( string )
!DEC$ ATTRIBUTES DEFAULT :: $$msportlib$date$s
!DEC$ ATTRIBUTES alias:'_DATE@8' :: $$msportlib$date$s
    character(len=9) string
  end subroutine
end interface
!****
!**** File System 
!****
! Bits for 'mode' (stat(3))
integer(4), parameter :: S_IFMT   = 8#0170000
integer(4), parameter :: S_IFDIR  = 8#0040000
integer(4), parameter :: S_IFCHR  = 8#0020000 
integer(4), parameter :: S_IFBLK  = 8#0060000 
integer(4), parameter :: S_IFREG  = 8#0100000 
integer(4), parameter :: S_IFLNK  = 8#0120000
integer(4), parameter :: S_IFSOCK = 8#0140000 
integer(4), parameter :: S_ISUID  = 8#0004000 
integer(4), parameter :: S_ISGID  = 8#0002000 
integer(4), parameter :: S_ISVTX  = 8#0001000 
integer(4), parameter :: S_IRWXU  = 8#0000700 
integer(4), parameter :: S_IRUSR  = 8#0000400 
integer(4), parameter :: S_IREAD  = 8#0000400 
integer(4), parameter :: S_IWUSR  = 8#0000200 
integer(4), parameter :: S_IWRITE = 8#0000200 
integer(4), parameter :: S_IXUSR  = 8#0000100 
integer(4), parameter :: S_IEXEC  = 8#0000100 
integer(4), parameter :: S_IRWXG  = 8#0000070 
integer(4), parameter :: S_IRGRP  = 8#0000040 
integer(4), parameter :: S_IWGRP  = 8#0000020 
integer(4), parameter :: S_IXGRP  = 8#0000010 
integer(4), parameter :: S_IRWXO  = 8#0000007 
integer(4), parameter :: S_IROTH  = 8#0000004 
integer(4), parameter :: S_IWOTH  = 8#0000002 
integer(4), parameter :: S_IXOTH  = 8#0000001 
integer(4), parameter :: MAX_GETCWD_LENGTH = 260
interface 
  integer(4) function chmod( fname, mode )
!DEC$ ATTRIBUTES DEFAULT :: chmod
    character(len=*) fname, mode
  end function
  integer(4) function access( fname, mode )
!DEC$ ATTRIBUTES DEFAULT :: access
    character(len=*) fname, mode
  end function
  integer(4) function rename( from, to )
!DEC$ ATTRIBUTES DEFAULT :: rename
    character(len=*) from, to
  end function
  integer(4) function unlink( file )
!DEC$ ATTRIBUTES DEFAULT :: unlink
    character(len=*) file
  end function
  integer(4) function chdir( dirname )
!DEC$ ATTRIBUTES DEFAULT :: chdir
    character(len=*) dirname
  end function
  integer(4) function getcwd( dirname )
!DEC$ ATTRIBUTES DEFAULT :: getcwd
    character(len=*) dirname
  end function
  integer(4) function lstat( name, statb )
!DEC$ ATTRIBUTES DEFAULT :: lstat
    character(len=*) name
    integer(4) statb(12)
  end function
  integer(4) function stat( name, statb )
!DEC$ ATTRIBUTES DEFAULT :: stat
    character(len=*) name
    integer(4) statb(12)
  end function
end interface
!****
!**** Bit Manipulation
!****
interface
  subroutine bic( bitnum, target )
!DEC$ ATTRIBUTES DEFAULT :: bic
    integer(4) bitnum, target
  end subroutine
  subroutine bis( bitnum, target )
!DEC$ ATTRIBUTES DEFAULT :: bis
    integer(4) bitnum, target
  end subroutine
  logical(4) function bit( bitnum, target )
!DEC$ ATTRIBUTES DEFAULT :: bit
    integer(4) bitnum, target
  end function
end interface 
!****
!**** Type conversion
!****
interface
  integer(2) function short( i )
!DEC$ ATTRIBUTES DEFAULT :: short
    integer(4) i
  end function
  integer(4) function long( i )
!DEC$ ATTRIBUTES DEFAULT :: long
    integer(2) i
  end function
end interface
  
!****
!**** Process Environment 
!****
!!!!!!!!!integer(4), parameter :: MAX_HOSTNAM_LENGTH = 40
!This constant should have the same value and use as
! MAX_COMPUTERNAME_LENGTH from DFWINTY or winbase.h.
integer(4), parameter :: MAX_HOSTNAM_LENGTH = 15


integer(4), parameter :: MAX_GETLOG_LENGTH = 20
interface
  integer(4) function getgid()
!DEC$ ATTRIBUTES DEFAULT :: getgid
  end function
  integer(4) function getuid()
!DEC$ ATTRIBUTES DEFAULT :: getuid
  end function
  integer(4) function getpid()
!DEC$ ATTRIBUTES DEFAULT :: getpid
  end function
  integer(4) function iargc()
!DEC$ ATTRIBUTES DEFAULT :: iargc
  end function
  integer(4) function hostnam( name )
!DEC$ ATTRIBUTES DEFAULT :: hostnam
    character(len=*) name
  end function
  subroutine getlog( name )
!DEC$ ATTRIBUTES DEFAULT :: getlog
    character(len=*) name
  end subroutine
  subroutine getenv( variable, string )
!DEC$ ATTRIBUTES DEFAULT :: getenv
    character(len=*) variable, string
  end subroutine
end interface
!****
!**** String Manipulation
!****
  
interface
  integer(4) function lnblnk( string )
!DEC$ ATTRIBUTES DEFAULT :: lnblnk
    character(len=*) string
  end function
  integer(4) function rindex( string, substr )
!DEC$ ATTRIBUTES DEFAULT :: rindex
    character(len=*) string, substr
  end function
end interface
!****
!**** Quick Sort
!****
! Qsort can take ANY type for the type of 'array', but because of 
! Fortran 90's strict rules about data typing, you need to declare
! each type you wish to use.  Included here are declarations for all
! the intrinsic data types.  To add a data type, overload the generic
! interface 'qsort' with your own data type, just as was done below. 
!
! For example, if you wanted to sort an array of type(foo), you would
! include the following in your program:
!
!      module goo
!        use portlib
!        type foo 
!          integer a, b
!        end type
!        interface qsort
!          subroutine qsort_typefoo( array, len, isize, compar )
!            !DEC$ ATTRIBUTES alias:'_QSORT@16' :: qsort_typefoo
!            !* NOTE you must either include another copy of the declaration
!            !* for foo here, or place foo in a separate module and USE
!            !* here and in module goo.  This is because Fortran 90 does
!            !* allow a declaration from outside the interface to be seen.
!            type foo
!              integer a, b
!            end type
!            type(foo) array(*)
!            integer len, isize
!            integer(2), external :: compar
!          end subroutine
!        end interface
!      contains
!        ! ... you can use qsort with type(foo) in here ...
!      end module
interface qsort
  subroutine $$msportlib$qsorti1( array, len, isize, compar )
!DEC$ ATTRIBUTES DEFAULT :: $$msportlib$qsorti1
    !DEC$ ATTRIBUTES alias:'_QSORT@16' :: $$msportlib$qsorti1
    integer(1) array(*); integer len, isize; integer(2), external :: compar
  end subroutine
  subroutine $$msportlib$qsorti2( array, len, isize, compar )
!DEC$ ATTRIBUTES DEFAULT :: $$msportlib$qsorti2
    !DEC$ ATTRIBUTES alias:'_QSORT@16' :: $$msportlib$qsorti2
    integer(2) array(*); integer len, isize; integer(2), external :: compar
  end subroutine
  subroutine $$msportlib$qsorti4( array, len, isize, compar )
!DEC$ ATTRIBUTES DEFAULT :: $$msportlib$qsorti4
    !DEC$ ATTRIBUTES alias:'_QSORT@16' :: $$msportlib$qsorti4
    integer(4) array(*); integer len, isize; integer(2), external :: compar
  end subroutine
  subroutine $$msportlib$qsortr4( array, len, isize, compar )
!DEC$ ATTRIBUTES DEFAULT :: $$msportlib$qsortr4
    !DEC$ ATTRIBUTES alias:'_QSORT@16' :: $$msportlib$qsortr4
    real(4) array(*); integer len, isize; integer(2), external :: compar
  end subroutine
  subroutine $$msportlib$qsortr8( array, len, isize, compar )
!DEC$ ATTRIBUTES DEFAULT :: $$msportlib$qsortr8
    !DEC$ ATTRIBUTES alias:'_QSORT@16' :: $$msportlib$qsortr8
    real(8) array(*); integer len, isize; integer(2), external :: compar
  end subroutine
  subroutine $$msportlib$qsortc4( array, len, isize, compar )
!DEC$ ATTRIBUTES DEFAULT :: $$msportlib$qsortc4
    !DEC$ ATTRIBUTES alias:'_QSORT@16' :: $$msportlib$qsortc4
    complex(4) array(*); integer len, isize; integer(2), external :: compar
  end subroutine
  subroutine $$msportlib$qsortc8( array, len, isize, compar )
!DEC$ ATTRIBUTES DEFAULT :: $$msportlib$qsortc8
    !DEC$ ATTRIBUTES alias:'_QSORT@16' :: $$msportlib$qsortc8
    complex(8) array(*); integer len, isize; integer(2), external :: compar
  end subroutine
  subroutine $$msportlib$qsortl1( array, len, isize, compar )
!DEC$ ATTRIBUTES DEFAULT :: $$msportlib$qsortl1
    !DEC$ ATTRIBUTES alias:'_QSORT@16' :: $$msportlib$qsortl1
    logical(1) array(*); integer len, isize; integer(2), external :: compar
  end subroutine
  subroutine $$msportlib$qsortl2( array, len, isize, compar )
!DEC$ ATTRIBUTES DEFAULT :: $$msportlib$qsortl2
    !DEC$ ATTRIBUTES alias:'_QSORT@16' :: $$msportlib$qsortl2
    logical(2) array(*); integer len, isize; integer(2), external :: compar
  end subroutine
  subroutine $$msportlib$qsortl4( array, len, isize, compar )
!DEC$ ATTRIBUTES DEFAULT :: $$msportlib$qsortl4
    !DEC$ ATTRIBUTES alias:'_QSORT@16' :: $$msportlib$qsortl4
    logical(4) array(*); integer len, isize; integer(2), external :: compar
  end subroutine
  subroutine $$msportlib$qsortchar( array, len, isize, compar )
!DEC$ ATTRIBUTES DEFAULT :: $$msportlib$qsortchar
    ! NOTE the 20 in the following line, because of the hidden length arg
    !DEC$ ATTRIBUTES alias:'_QSORT@20' :: $$msportlib$qsortchar    
    character(*) array(*); integer len, isize; integer(2), external :: compar
  end subroutine
end interface
!****
!**** Stream I/O
!****
integer(4), parameter :: SEEK_SET = 0 
integer(4), parameter :: SEEK_CUR = 1 
integer(4), parameter :: SEEK_END = 2 
interface 
  integer(4) function fseek( unit, position, seekfrom )
!DEC$ ATTRIBUTES DEFAULT :: fseek
    integer(4) unit, position, seekfrom
  end function
  integer(4) function fseek64( unit, position, seekfrom )
!DEC$ ATTRIBUTES DEFAULT :: fseek64
    integer(4) unit, seekfrom
    integer(8) position
  end function
  integer(4) function fgetc( unit, char )
!DEC$ ATTRIBUTES DEFAULT :: fgetc
    integer(4) unit
    character char
  end function
  integer(4) function getc( char )
!DEC$ ATTRIBUTES DEFAULT :: getc
    character char
  end function
  integer(4) function fputc( unit, char )
!DEC$ ATTRIBUTES DEFAULT :: fputc
    integer(4) unit
    character char
  end function
  integer(4) function putc( char )
!DEC$ ATTRIBUTES DEFAULT :: putc
    character char
  end function
  integer(4) function ftell( unit )
!DEC$ ATTRIBUTES DEFAULT :: ftell
    integer(4) unit
  end function
  integer(8) function ftell64( unit )
!DEC$ ATTRIBUTES DEFAULT :: ftell64
    integer(4) unit
  end function
  subroutine flush( unit )
!DEC$ ATTRIBUTES DEFAULT :: flush
    integer(4) unit
  end subroutine
  integer(4) function fstat( unit, statb )
!DEC$ ATTRIBUTES DEFAULT :: fstat
    integer(4) unit
    integer(4) statb(12)
  end function
end interface
!****
!**** Random numbers
!****
interface random
  real(4) function $$msportlib$random( iflag )
!DEC$ ATTRIBUTES DEFAULT :: $$msportlib$random
!DEC$ ATTRIBUTES ALIAS:'_$$MSPORTLIB$RANDOM@4' :: $$msportlib$random
    integer(4) iflag
  end function
end interface
interface
  integer(4) function irandm( iflag )
!DEC$ ATTRIBUTES DEFAULT :: irandm
    integer(4) iflag
  end function
  real(8) function drand( iflag )
!DEC$ ATTRIBUTES DEFAULT :: drand
    integer(4) iflag
  end function
  real(8) function drandm( iflag )
!DEC$ ATTRIBUTES DEFAULT :: drandm
    integer(4) iflag
  end function
  real(4) function ran( seed )
!DEC$ ATTRIBUTES DEFAULT :: ran
    integer(4) seed
  end function
end interface
interface rand
  real(4) function $$msportlib$rand$i( iflag )
!DEC$ ATTRIBUTES DEFAULT :: $$msportlib$rand$i
!DEC$ ATTRIBUTES alias:'_RAND@4' :: $$msportlib$rand$i
    integer(4) iflag
  end function
  real(4) function $$msportlib$rand()
!DEC$ ATTRIBUTES DEFAULT :: $$msportlib$rand
!DEC$ ATTRIBUTES alias:'_RAND@0' :: $$msportlib$rand
  end function
end interface
interface irand
  integer(4) function $$msportlib$irand$i( iflag )
!DEC$ ATTRIBUTES DEFAULT :: $$msportlib$irand$i
!DEC$ ATTRIBUTES alias:'_IRAND@4' :: $$msportlib$irand$i
    integer(4) iflag
  end function
  integer(4) function $$msportlib$irand()
!DEC$ ATTRIBUTES DEFAULT :: $$msportlib$irand
!DEC$ ATTRIBUTES alias:'_IRAND@0' :: $$msportlib$irand
  end function
end interface
interface srand
  subroutine $$msportlib$srand$i( iseed )
!DEC$ ATTRIBUTES DEFAULT :: $$msportlib$srand$i
!DEC$ ATTRIBUTES alias:'_SRAND@4' :: $$msportlib$srand$i
    integer(4) iseed
  end subroutine
  subroutine $$msportlib$srand$r( rseed )
!DEC$ ATTRIBUTES DEFAULT :: $$msportlib$srand$r
!DEC$ ATTRIBUTES alias:'_SRAND@4' :: $$msportlib$srand$r
    real(4) rseed
  end subroutine
end interface
!****
!**** Process control
!****
integer(4), parameter :: SIGABRT = 6    ! Abnormal termination
integer(4), parameter :: SIGFPE = 8     ! Floating Point error
integer(4), parameter :: SIGILL = 4     ! Illegal instruction
integer(4), parameter :: SIGINT = 2     ! CTRL+C signal
integer(4), parameter :: SIGKILL = 9    ! Kill Process
integer(4), parameter :: SIGTERM = 15   ! Termination request
integer(4), parameter :: SIGSEGV = 11   ! Illegal storage access
interface
  integer(4) function signal( signum, proc, flag )
!DEC$ ATTRIBUTES DEFAULT :: signal
    integer(4) signum, flag
    external proc
  end function
  integer(4) function kill( pid, signum )
!DEC$ ATTRIBUTES DEFAULT :: kill
    integer(4) pid, signum
  end function
  integer(4) function alarm( time, proc )
!DEC$ ATTRIBUTES DEFAULT :: alarm
    integer(4) time
    external proc
  end function
  integer(4) function system( command )
!DEC$ ATTRIBUTES DEFAULT :: system
    character(len=*) command
  end function
  subroutine sleep( n )
!DEC$ ATTRIBUTES DEFAULT :: sleep
    integer(4) n
  end subroutine
end interface
interface abort
  subroutine $$msportlib$abort
!DEC$ ATTRIBUTES DEFAULT :: $$msportlib$abort
!DEC$ ATTRIBUTES alias:'_ABORT@0' :: $$msportlib$abort
  end subroutine
  subroutine $$msportlib$abort$s( string )
!DEC$ ATTRIBUTES DEFAULT :: $$msportlib$abort$s
!DEC$ ATTRIBUTES alias:'_ABORT@8' :: $$msportlib$abort$s
    character(len=*) string
  end subroutine
end interface
!DEC$ IF .NOT. DEFINED(__DFPORT_INCLUDE)
END MODULE DFPORT
!DEC$ ENDIF
!***************************************************************************
!* End of module DFPORT
!***************************************************************************
