C+
C NAME:
C	iOSGetForeign
C CATEGORY:
C	Machine-dependent functions: WIN-NT
C PURPOSE:
C	Get command line arguments as single string
C CALLING SEQUENCE:
	function iOSGetForeign(L,cStr)
C INPUTS:
C	(none)
C OUTPUTS:
C	L		integer		useful length of cStr (=itrim(cStr))
C	cStr		character*(*)	command line string
C	iOSGetForeign	integer		0: no command line string (--> L=0)
C					1: command line string present (L > 0)
C CALLS:
C	itrim
C PROCEDURE:
C	NARGC returns the number of command line arguments.
C	These are picked up with GETARG and strung together in cStr
C MODIFICATION HISTORY:
C	SEP-1999, Paul Hick (UCSD/CASS; pphick@ucsd.edu); Added documentation
C-
	    integer	L
	    character	cStr*(*)

	N = IARGC()
	L = 0
	cStr = ' '
	do I=1,N
	    if (L .ne. 0) L = L+1
	    call GETARG(I,cStr(L+1:))
	    L = itrim(cStr)
	end do
	iOSGetForeign = min(L,1)

	return
	end
C+
C NAME:
C	iOSSpawnCmd
C PURPOSE:
C	Execute a single shell command
C CATEGORY:
C	Machine-dependent functions: WIN-NT
C CALLING SEQUENCE:
	function iOSSpawnCmd(Cmd,iNoWait)
C INPUTS:
C	Cmd		character*(*)	shell command
C	iNoWait		integer		(not used; kept for compatibility with VMS)
C OUTPUTS:
C	iOSSpawnCmd	integer		0: error executing command
C					1: command executed succesully
C RESTRICTIONS:
C CALLS:
C	itrim, iGetLogical
C PROCEDURE:
C	The error status is determined from the return value of the SYSTEM call.
C	By default the NT command shell cmd.exe is prefixed to the input shell command.
C	Override this by setting the logical 'win_cmd' in $home/LOGFIL.TXT
C	(e.g. on Windows 98 add the line 'LOG=win_cmd=command.com /c')
C MODIFICATION HISTORY:
C	SEP-1999, Paul Hick (UCSD/CASS; pphick@ucsd.edu); Added documentation
C-
	    character	Cmd*(*)
	    integer	iNoWait

	character	win_cmd*32
	integer		SYSTEM

	iOSSpawnCmd = itrim(Cmd)

	if (iOSSpawnCmd .gt. 0) then

	    if (iGetLogical('win_cmd',win_cmd) .eq. 0) win_cmd = 'cmd.exe /c'

	    if (SYSTEM(win_cmd(:itrim(win_cmd))//' '//Cmd) .eq. 0) then
		iOSSpawnCmd = 1
	    else
		iOSSpawnCmd = 0
	    end if

	end if
	
	return
	end
C+
C NAME:
C	OSExitCmd
C PURPOSE:
C	Terminate program execution. Set an exit code for external use
C	Current status: disfunctional
C CATEGORY:
C	Machine-dependent functions: WIN-NT
C CALLING SEQUENCE:
	subroutine OSExitCmd(Cmd,iCode)
C INPUTS:
C	Cmd		character*(*)	shell command passed to SYSTEM
C	iCode		integer		error code passed to EXIT function
C OUTPUTS:
C	(none)
C CALLS:
C	itrim, bGetLun, iFreeLun, iFilePath
C INCLUDE:
	include		'filparts.h'
	include		'dirspec.h'
C PROCEDURE:
C >	The cDo string is used on VMS to pass some information to the calling
C	command procedure. Here the shell command is executed by passing it to SYSTEM
C	(if it is not an empty string). This is probably not very useful since this
C	information (e.g. a directory change) is not passed to the calling shell.
C	(see the Unix version for a different solution for this problem).
C >	The main purpose of this subroutine is to set an exit code to be checked
C	by a script or command procedure. This is usually done using the EXIT function
C	A Fortran compiled with Absoft Fortran as a windows application kills the
C	input/output window when EXIT is executed.
C	For the time begin the STOP statement is executed:
C		stop ' %OSExitCmd-I-Exit, program terminated'
C MODIFICATION HISTORY:
C	SEP-1999, Paul Hick (UCSD/CASS; pphick@ucsd.edu); Added documentation
C-
	    character 	Cmd*(*)
	    integer	iCode

	character	cFile*(FIL__LENGTH)
	logical	  	bGetLun
	integer		SYSTEM

	iCmd = itrim(Cmd)
	if (iCmd .gt. 0) then
	    I = SYSTEM(Cmd)
	    if (iCode .ne. 999) I = iCode
	    !I = iCode
	else
	    I = iCode
	end if

	!-------
	! In batch file execute 'call $temp\osexitcmd.bat'.
	! This sets environment variable ICODE to argument iCode.

	if (bGetLun(iU,cTemp)) then	! Get logical unit number
	    I = iFilePath(cTemp,0,' ','OSExitCmd.bat',cFile)
	    open (iU, file=cFile, status='UNKNOWN')
	    write (iU,'(A,I1)') 'SET STATUS=',iCode
	    write (iU,'(A)') 'exit'
	    iU = iFreeLun(iU)		! Close file
	end if

	if (I .eq. I) stop '%OSExitCmd-I-Exit, end program'
	!call EXIT(I)			! Destroys input/output window

	return
	end
C+
C NAME:
C	iOSGetDirectory
C PURPOSE:
C	Get a fully-qualified directory name, incl. drive and directory
C CATEGORY:
C	Machine-dependent functions: WIN-NT, Linux, Unix
C CALLING SEQUENCE:
	function iOSGetDirectory(cDir)
C INPUTS:
C	cDir		character*(*)	(incomplete) directory name
C OUTPUTS:
C	cDir		character*(*)	complete directory name,
C					incl. trailing backslash
C	iOSGetDirectory	integer		0: if GETCWD failed
C					1: if GETCWD succesful
C CALLS:
C	itrim
C INCLUDE:
	include		'dirspec.h'
C RESTRICTIONS:
C	Do NOT call this function directly. Instead use iSearch.
C PROCEDURE:
C	Uses system function GETCWD
C MODIFICATION HISTORY:
C	SEP-1999, Paul Hick (UCSD/CASS; pphick@ucsd.edu); Added documentation
C-
	    character	cDir*(*)

	integer		GETCWD

	if (GETCWD(cDir) .eq. 0) then
	    I = itrim(cDir)
	    if (cDir(I:I) .ne. cTrail) cDir(I+1:) = cTrail ! Return with trailing backslash
	    iOSGetDirectory = 1
	else
	    iOSGetDirectory = 0
	end if

	return
	end
C+
C NAME:
C	iOSCheckDirectory
C PURPOSE:
C	Check whether a directory exists
C CATEGORY:
C	Machine-dependent functions: WIN-NT
C CALLING SEQUENCE:
	function iOSCheckDirectory(cDir)
C INPUTS:
C	cDir	character*(*)	(incomplete) directory name
C OUTPUTS:
C	cDir	character*(*)	if the directory exists, a (back)slash is added
C				if it is not there already; if it does not exist
C				value is returned unmodified
C	iOSCheckDirectory
C		integer		0: directory does not exist
C				1: directory exists
C CALLS:
C	itrim
C INCLUDE:
	include		'filparts.h'
	include		'dirspec.h'
C RESTRICTIONS:
C	Do NOT call this function directly. Instead use iSearch.
C PROCEDURE:
C	Existence of the directory is tested by changing directory
C	using CHDIR and checking its exit status. The current directory
C	is saved using GETCWD and is restored before returning.
C MODIFICATION HISTORY:
C	SEP-1999, Paul Hick (UCSD/CASS; pphick@ucsd.edu); Added documentation
C-
	    character	cDir*(*)

	character	cOld*(FIL__LENGTH)
	integer		CHDIR
	integer		GETCWD


	iOSCheckDirectory = 0

	if (GETCWD(cOld) .eq. 0) then
	    if (CHDIR(cDir) .eq. 0) then
		I = itrim(cDir)
		if (cDir(I:I) .ne. cTrail) cDir(I+1:) = cTrail
		iOSCheckDirectory = 1
	    end if					! Return with trailing backslash
	    if (CHDIR(cOld) .ne. 0) iOSCheckDirectory = 0
	end if

	return
	end
C+
C NAME:
C	iOSSetDirectory
C PURPOSE:
C	Change to a new working directory
C CATEGORY:
C	Machine-dependent functions: WIN-NT
C CALLING SEQUENCE:
	function iOSSetDirectory(cDir)
C INPUTS:
C	cDir	character*(*)	(incomplete) directory name
C OUTPUTS:
C	iOSSetDirectory
C		integer		0: change of directory failed
C				1: change of directory successful
C RESTRICTIONS:
C	Do NOT call this function directly. Use iSetDefaultDir..
C PROCEDURE:
C	Input is passed unmodified to CHDIR. Return status is
C	determined from CHDIR exit status.
C MODIFICATION HISTORY:
C	SEP-1999, Paul Hick (UCSD/CASS; pphick@ucsd.edu); Added documentation
C-
	    character	cDir*(*)

	integer		CHDIR

	if (CHDIR(cDir) .eq. 0) then
	    iOSSetDirectory = 1
	else
	    iOSSetDirectory = 0
	end if

	return
	end
C+
C NAME:
C	iOSDeleteFile
C PURPOSE:
C	Delete a file
C CATEGORY:
C	Machine-dependent functions: WIN-NT
C CALLING SEQUENCE:
	function iOSDeleteFile(cFile)
C INPUTS:
C	cFile		character*(*)	file to be deleted
C OUTPUTS:
C	iOSDeleteFile	integer		0: delete failed
C					1: delete successful
C PROCEDURE:
C	Input is passed unmodified to UNLINK. Return status is determined
C	from UNLINK exit status.
C MODIFICATION HISTORY:
C	SEP-1999, Paul Hick (UCSD/CASS; pphick@ucsd.edu); Added documentation
C-
	    character	cFile*(*)

	integer		UNLINK

	if (UNLINK(cFile) .eq. 0) then
	    iOSDeleteFile = 1
	else
	    iOSDeleteFile = 0
	end if

	return
	end
C+
C NAME:
C	iOSRenameFile
C PURPOSE:
C	Rename a file
C CATEGORY:
C	Machine-dependent functions: WIN-NT
C CALLING SEQUENCE:
	function iOSRenameFile(cFile1,cFile2)
C INPUTS:
C	cFile1		character*(*)	file to be renamed
C	cFile2		character*(*)	new file name
C OUTPUTS:
C	iOSRenameFile	integer		0: rename failed
C					1: rename successful
C PROCEDURE:
C	Input is passed unmodified to RENAME. Return status is determined
C	from RENAME exit status.
C MODIFICATION HISTORY:
C	SEP-1999, Paul Hick (UCSD/CASS; pphick@ucsd.edu); Added documentation
C-
	    character	cFile1*(*)
	    character	cFile2*(*)

	integer		RENAME

	if (RENAME(cFile1,cFile2) .eq. 0) then
	    iOSRenameFile = 1
	else
	    iOSRenameFile = 0
	end if

	return
	end
C+
C NAME:
C	iOSCopyFile
C PURPOSE:
C	Copies a file
C CATEGORY:
C	Machine-dependent functions: WIN-NT
C CALLING SEQUENCE:
	function iOSCopyFile(cFile1,cFile2)
C INPUTS:
C	cFile1		character*(*)	file to be copied
C	cFile2		character*(*)	new file name
C OUTPUTS:
C	iOSCopyFile	integer		0: copy failed
C					1: copy successful
C CALLS:
C	itrim, Str2Str, iSearch
C INCLUDE:
	include		'filparts.h'
	include		'dirspec.h'
C RESTRICTIONS:
C PROCEDURE:
C	Roundabout way of copying a file by passing a
C	a copy command to the SYSTEM procedure.
C MODIFICATION HISTORY:
C	SEP-1999, Paul Hick (UCSD/CASS; pphick@ucsd.edu); Added documentation
C-
	    character	cFile1*(*)
	    character	cFile2*(*)

	character	cStr1*(FIL__LENGTH)
	character	cStr2*(FIL__LENGTH)
	integer		SYSTEM

	iOSCopyFile = 0

	if (iSearch(1,cFile2,cStr1) .eq. 1) return

	if (cOpSys .eq. OS__DOS) then
	    cStr2 = 'cmd /c copy'
	else
	    cStr2 = 'cp'
	end if

	I = itrim(cStr2)+1
	I = I+Str2Str(cFile1,cStr2(I+1:))
	I = I+1
	I = I+Str2Str(cFile2,cStr2(I+1:))

	I = SYSTEM(cStr2)

	if (iSearch(1,cFile2,cStr1) .ne. 1) return

	iOSCopyFile = 1

	return
	end
C+
C NAME:
C	iOSProtect
C PURPOSE:
C	Modify protection of a file
C CATEGORY:
C	Machine-dependent functions: WIN-NT
C CALLING SEQUENCE:
	function iOSProtect(cFile,iProt,iCode)
C INPUTS:
C	cFile		character*(*)	file to be protected
C	iProt		integer		not used
C	iCode		integer		not used
C OUTPUTS:
C	iOSProtect	integer		always 1
C PROCEDURE:
C	NOT IMPLEMENTED
C MODIFICATION HISTORY:
C	SEP-1999, Paul Hick (UCSD/CASS; pphick@ucsd.edu); Added documentation
C-
	    character	cFile*(*)
	    integer	iProt
	    integer	iCode

	character cDum

	cDum = cFile		! Dummies to avoid compiler warnings
	i = iCode
	i = iProt

	iOSProtect = 1

	return
	end