MODULE SysSubs ! This module contains routines with system-specific logic and references. CONTAINS !======================================================================= SUBROUTINE Get_Arg ( Arg_Num , Arg , Error ) ! This routine gets Arg_Num'th argument from the command line. IMPLICIT NONE ! Passed variables. INTEGER(4) :: Arg_Num ! The argument number to get. LOGICAL(1) :: Error ! The error flag returned to the calling program. CHARACTER(*) :: Arg ! The argument string returned to the calling program. ! Local variables. INTEGER(4) :: Status ! The status of the attempt to get an argument. CALL GETARG ( Arg_Num, Arg, Status ) IF ( LEN_TRIM( Arg ) > 0 ) THEN Error = .FALSE. ELSE Error = .TRUE. ENDIF RETURN END SUBROUTINE Get_Arg !======================================================================= SUBROUTINE Get_Arg_Num ( Arg_Num ) ! This routine gets the number of command line arguments. USE IFPORT IMPLICIT NONE ! Passed variables. INTEGER(4) :: Arg_Num ! The argument to get from the command line. Arg_Num = IARGC() RETURN END SUBROUTINE Get_Arg_Num !======================================================================= SUBROUTINE Get_CWD ( DirName ) ! This routine retrieves the path of the current working directory. USE IFPORT IMPLICIT NONE ! Passed variables. CHARACTER(*) :: DirName ! A CHARACTER string containing the path of the current working directory. ! Local variables. INTEGER(4) :: Status ! Status returned by the call to a portability routine. Status = GETCWD ( DirName ) IF ( Status /= 0 ) CALL Abort ( ' Error calling portability routine GETCWD().' ) RETURN END SUBROUTINE Get_CWD !======================================================================= SUBROUTINE OpenCon ! This routine opens the console for standard output. USE System IMPLICIT NONE OPEN ( CU , FILE='CON' , STATUS='UNKNOWN' , CARRIAGECONTROL='FORTRAN' ) CALL Flush ( CU ) RETURN END SUBROUTINE OpenCon !======================================================================= FUNCTION UserTime() ! This function returns the user CPU time. USE IFPORT ! Use the portability library. IMPLICIT NONE ! Passed variables. REAL(4) :: UserTime ! User CPU time. ! Local variables. REAL(4) :: TimeAry (2) ! TimeAry(1): User CPU time, TimeAry(2): System CPU time. REAL(4) :: TotTime ! User CPU time plus system CPU time. TotTime = DTIME( TimeAry ) UserTime = TimeAry(1) RETURN END FUNCTION UserTime !======================================================================= SUBROUTINE UsrAlarm ! This routine generates an alarm to warn the user that something went wrong. IMPLICIT NONE CALL WrNR ( CHAR( 7 ) ) RETURN END SUBROUTINE UsrAlarm !======================================================================= SUBROUTINE WrFileNR ( Unit, Str ) ! This routine writes out a string to the file connected to Unit without following it with a new line. IMPLICIT NONE ! Passed variables. INTEGER(4) :: Unit ! I/O unit for input file. CHARACTER(*) :: Str ! String to be written without a newline at the end. WRITE (Unit,'(A,$)') Str RETURN END SUBROUTINE WrFileNR !======================================================================= SUBROUTINE WrNR ( Str ) ! This routine writes out a string to the screen without following it with a new line. USE System IMPLICIT NONE ! Passed variables. CHARACTER(*) :: Str ! The string to write to the screen. WRITE (CU,'(1X,A,$)') Str RETURN END SUBROUTINE WrNR !======================================================================= SUBROUTINE WrOver ( Str ) ! This routine writes out a string that overwrites the previous line USE System IMPLICIT NONE ! Passed variables. CHARACTER(*) :: Str ! The string to write to the screen. WRITE (CU,'(''+'',A)') Str RETURN END SUBROUTINE WrOver !======================================================================= SUBROUTINE WrScr ( Str ) ! This routine writes out a string to the screen. USE System IMPLICIT NONE ! Passed variables. CHARACTER(*) :: Str ! The string to write to the screen. ! Local variables. INTEGER(4) :: Beg ! The beginning of the next line of text. INTEGER(4) :: Indent ! The amunt to be indented. INTEGER(4) :: LStr ! The length of the remaining portion of the string. INTEGER(4) :: MaxLen ! Maximum number of columns to be written to the screen. CHARACTER(10) :: Frm ! Format specifier for the output. ! Find the amount of indent. Create format. MaxLen = 98 Indent = LEN_TRIM( Str ) - LEN_TRIM( ADJUSTL( Str ) ) MaxLen = MaxLen - Indent IF ( Indent > 0 ) THEN Frm = '(1X, X,A)' WRITE (Frm(5:6),'(I2)') Indent ELSE Frm = '(1X,A)' END IF ! Break long messages into multiple lines. Beg = Indent + 1 LStr = LEN_TRIM( Str(Beg:) ) DO WHILE ( Lstr > MaxLen ) CALL FindLine ( Str(Beg:) , MaxLen , LStr ) WRITE (CU,Frm) TRIM( ADJUSTL( Str(Beg:Beg+LStr-1) ) ) Beg = Beg + LStr ! If we have a space at the beginning of the string, let's get rid of it DO WHILE ( Beg < LEN_TRIM( Str ) .AND. Str(Beg:Beg) == ' ' ) Beg = Beg + 1 ENDDO LStr = LEN_TRIM( Str(Beg:) ) ENDDO WRITE (CU,Frm) TRIM( ADJUSTL( Str(Beg:Beg+LStr-1) ) ) RETURN END SUBROUTINE WrScr !======================================================================= END MODULE SysSubs