C ---------------------------------------------------------------------- INTEGER FUNCTION GETCLARGS(io) C ---------------------------------------------------------------------- C - Stores the command line arguments in the io data structure C - INCLUDED FILES: #include "dyna.inc" #include "io.inc" C - UNMODIFIED ARGUMENTS: ! NONE C - MODIFIED ARGUMENTS: RECORD /Io_Data/ io C - MODIFIED GLOBAL DATA: ! NONE C - LOCAL VARIABLES: INTEGER i INTEGER iargc C - FUNCTIONS CALLED: ! IARGC ! <-- Sun FORTRAN function returning # of cl args ! GETARG ! <-- Sun FORTRAN function returning a given arg C - RETURN VALUE: ! Non-zero if there was an error C ---------------------------------------------------------------------- GETCLARGS = 0 io.numclargs = MIN(IARGC(),MAX_CLARGS) DO i = 1,io.numclargs CALL GETARG(i,io.clarg(i)) ENDDO WRITE(io.netfile,'(A)') 'dynain.dyn' ! Default io.gt_hostname = CHAR(0) io.gt_port = 0 io.dd_hostname = CHAR(0) io.dd_port = 0 io.show_warnings = .TRUE. CR - This CLARG interpretation should occur elsewhere..!!! CR:TODO i = 1 DO WHILE(i.LE.io.numclargs) IF (io.clarg(i)(1:2).EQ.'-f') THEN i = i + 1 IF (i.LE.io.numclargs) THEN io.netfile = io.clarg(i) ENDIF ELSE IF (io.clarg(i)(1:4).EQ.'-gth') THEN i = i + 1 IF (i.LE.io.numclargs) THEN READ(io.clarg(i),'(A)') io.gt_hostname ENDIF ELSE IF (io.clarg(i)(1:4).EQ.'-gtp') THEN i = i + 1 IF (i.LE.io.numclargs) THEN READ(io.clarg(i),'(I80)') io.gt_port ENDIF ELSE IF (io.clarg(i)(1:4).EQ.'-ddh') THEN i = i + 1 IF (i.LE.io.numclargs) THEN READ(io.clarg(i),'(A)') io.dd_hostname ENDIF ELSE IF (io.clarg(i)(1:4).EQ.'-ddp') THEN i = i + 1 IF (i.LE.io.numclargs) THEN READ(io.clarg(i),'(I80)') io.dd_port ENDIF ELSE IF (io.clarg(i)(1:3).EQ.'-nw') THEN io.show_warnings = .FALSE. ELSE IF (io.clarg(i)(1:2).EQ.'-w') THEN io.show_warnings = .TRUE. ELSE WRITE(ostr,'(3A)') 'Ignoring unknown argument [' + ,io.clarg(i)(1:LTR(io.clarg(i))),']'//CHAR(0) CALL DYNA_ERROR(ostr + ,DYNA_NONFATAL_WARNING + ,DYNA_INPUT_ERROR + ,DYNA_INVALID_CLARG) ENDIF i = i + 1 ENDDO RETURN END C ---------------------------------------------------------------------- INTEGER FUNCTION LTR(string) C ---------------------------------------------------------------------- C - Returns the length of a string less trailing blanks C - INCLUDED FILES: ! None C - UNMODIFIED ARGUMENTS: CHARACTER string*(*) C - MODIFIED ARGUMENTS: ! NONE C - MODIFIED GLOBAL DATA: ! NONE C - LOCAL VARIABLES: ! NONE C - FUNCTIONS CALLED: ! NONE C - RETURN VALUE: ! The length of the string less trailing blanks C ---------------------------------------------------------------------- LTR = 0 DO i = 1,LEN(string) IF (string(i:i).NE.' '.AND. + string(i:i).NE.CHAR(0)) LTR = i ENDDO RETURN END C ---------------------------------------------------------------------- INTEGER FUNCTION LTR_C(string) C ---------------------------------------------------------------------- C - Returns the length of a "C" string -- that is a string as C - terminated by a NULL character (CHAR(0)). C - INCLUDED FILES: ! None C - UNMODIFIED ARGUMENTS: CHARACTER string*(*) C - MODIFIED ARGUMENTS: ! NONE C - MODIFIED GLOBAL DATA: ! NONE C - LOCAL VARIABLES: ! NONE C - FUNCTIONS CALLED: ! NONE C - RETURN VALUE: ! The length of the string up to the first NULL character C ---------------------------------------------------------------------- LTR_C = 1 max = LEN(string) DO WHILE(string(LTR_C:LTR_C).NE.CHAR(0).AND.LTR_C.LT.max) LTR_C = LTR_C + 1 ENDDO LTR_C = LTR_C - 1 RETURN END C ---------------------------------------------------------------------- INTEGER FUNCTION LTR_TOT(string) C ---------------------------------------------------------------------- CHARACTER string*(*) LTR_TOT = MIN(LTR_C(string),LTR(string)) RETURN END INTEGER FUNCTION BTR(string) CHARACTER string*(*) BTR = 1 DO WHILE(string(BTR:BTR).EQ.' ' + .AND.BTR.LT.LEN(string)) BTR = BTR + 1 ENDDO RETURN END INTEGER FUNCTION GETWORD(string) CHARACTER string*(*) INTEGER loc loc = BTR(string) GETWORD = index(string(loc:loc),' ') + 1 IF (GETWORD.GT.LEN(STRING)) GETWORD = 0 RETURN END INTEGER FUNCTION CSTR(string) CHARACTER string*(*) CSTR = 1 DO WHILE(string(CSTR:CSTR).NE.CHAR(0).AND. + CSTR.LE.LEN(string)) CSTR = CSTR + 1 ENDDO CSTR = CSTR - 1 IF (CSTR.EQ.0) CSTR = LEN(string) RETURN END C --- ================================================================== C - This is a dummy write routine to be replaced by a "C" write C - routine. It mearly writes a string to a specified unit. C --- ================================================================== SUBROUTINE OUTPUT(iunit,string) CHARACTER string*(*) WRITE(iunit,'(A)') string(1:LTR(string)) RETURN END SUBROUTINE FND(iunit) CHARACTER line*256 10 READ(iunit,FMT='(A256)',END=999) line DO i = 1,256 IF (line(i:i).EQ.'!') GOTO 10 IF (line(i:i).NE.' ') GOTO 999 ENDDO GOTO 10 999 BACKSPACE(iunit) RETURN END SUBROUTINE DYNA_ERROR(str,errflag,errtype,errdescrip) #include "dyna.inc" CHARACTER str*(*),locstr*80 INTEGER errflag INTEGER errtype INTEGER errdescrip IF (errflag.EQ.DYNA_FATAL_ERROR) THEN WRITE(locstr,600) '---FATAL ERROR: ',errtype,errdescrip,CHAR(0) CALL SIMMSG(STATUS,locstr) ELSE IF (.NOT.show_warnings) RETURN WRITE(locstr,600) '---NONFATAL WARNING: ' + ,errtype,errdescrip,CHAR(0) CALL SIMMSG(STATUS,locstr) ENDIF 600 FORMAT(A,2I10,A) IF (str(1:1).NE.CHAR(0)) THEN CALL SIMMSG(STATUS,str) ENDIF IF (errflag.EQ.DYNA_FATAL_ERROR) STOP '---TERMINATING' CALL SIMMSG(STATUS,'---CONTINUING') END