! Make sure that any input filename specified with the -i option has an ! extension of some kind. ! !********************************************************************** ! MAIN for TSTERODE !********************************************************************** ! ! +++ PURPOSE +++ ! ! To start a standalone version of the EROSION submodel ! ! It calls ERODEIN to read an input file (stdin), ! calls ERODINIT to initialize grid, ! runs the EROSION submodel code, and ! calls ERODOUT to print the generated output (stdout). ! ! +++ ARGUMENT DECLARATIONS +++ ! ! + + + GLOBAL COMMON BLOCKS + + + ! include 'p1werm.inc' include 'm1flag.inc' include 'util/misc/f2kcli.fi' !declarations for f2k commandline functions include 'command.inc' ! ! ! + + + LOCAL COMMON BLOCKS include 'erosion/p1erode.inc' !obtain access to SURF_UPD_FLG variable ! ! ++++ ARGUMENT DEFINITIONS +++ ! ! +++ SUBROUTINES CALLED+++ ! erodin ! erodinit ! erosion ! erodout ! ++++ LOCAL VARIABLES +++ character*1024 exe_filepath character*1024 input_filepath integer i_unit integer o_unit integer cmd_iarg !Temp var for retrieving integer cmdline args character*1024 argv !For Fortran 2k commandline parsing integer i integer numarg integer ll, ss integer iostat logical have_ifile integer indx, rndx integer E_out !Flag specifying summary erosion output to print integer o_E_unit !Unit number of file to print summary erosion to character*80 o_E_ext character*1024 o_E_file character*1024 o_E_filepath ! +++ END SPECIFICATIONS +++ saeinp_daysim = 0 !initialize WEPS variables saeinp_jday = 0 !not used in the standalone submodel SURF_UPD_FLG = 1 !enable erosion submodel surface updating by default have_ifile = .false. ! Set unit numbers for input and output file devices. ! (stdin = 5, stdout = 6) i_unit = 5 !If -i option is specified, use unit number 50 o_unit = 6 E_out = 0 !Assume no Erosion summary output by default o_E_unit = 10 !Erosion summary output (file unit number) o_E_ext = ".ero" !filename extension for Erosion summary output ! ! Uses the Fortran 2k commandline parsing support. ! There cannot be any space between the option and any arguments, ! e.g. '-i#' is ok but '-i #' is not. ! Any option arguments that have any spaces in them must be quoted, ! e.g. '-i"C:\Program Files"' is ok but '-iC:\Program Files' is not. numarg = COMMAND_ARGUMENT_COUNT() ! Determine number of commandline args call GET_COMMAND_ARGUMENT(0,argv,ll,ss) !get name of executing program !write(0,*) 'argv ',i,' is: ', trim(argv) ! debug print of arg list exe_filepath = trim(argv) if (numarg .gt. 0) then do 09 i = 1, numarg call GET_COMMAND_ARGUMENT(i,argv,ll,ss) !Fortran 2k compatible call !write(0,*) 'argv ',i,' is: ', trim(argv) ! debug print of arg list if (argv(1:1) .ne. '-') then !make sure all options start with '-' write(0,*) 'Option ignored, no option flag: ', trim(argv) goto 09 !Go get next arg endif !command line help prompt if( (argv(2:2).eq.'?').or.(argv(2:2).eq.'h')) then write(0,*) 'Valid command line options:' write(0,*) '-? or -h Display this help screen' write(0,*) '-u disable erosion surface updating' write(0,*) '-i "input_filename"' write(0,*) '-E Erosion Summary (kg/m^2)' write(0,*) ' Total salt/creep susp PM10 filename' stop else if (argv(2:2) == 'u') then !Turn off surface updating SURF_UPD_FLG = 0 else if (argv(2:2) == 'i') then !check if arg option is missing if (len_trim(argv(3:)) == 0) then STOP 'missing -i filename option' else input_filepath = trim(argv(3:)) i_unit = 50 !Assign unit number for input file open (i_unit, FILE=input_filepath, IOSTAT=iostat, & & STATUS='old') if (iostat /= 0) then write(0,*) 'input_filepath:', trim(input_filepath) write(0,*) 'iostat', iostat STOP 'Error opening input file' endif endif have_ifile = .true. else if (argv(2:2) == 'E') then if (.not. have_ifile) then STOP 'Need to specify input file prior to -E option' endif E_out = 1 !Assume all summary erosion values ! !check if arg option is missing ! if (len_trim(argv(3:)) == 0) then ! E_out = 0 !Assume all summary erosion values ! else ! read(argv(3:),IOSTAT=iostat,FMT=*) cmd_iarg ! ! !check for invalid flag option (non-integer, etc.) ! if (iostat > 0) then ! !write(0,*) 'argv3:', trim(argv(3:)) ! !write(0,*) 'iostat', iostat ! STOP 'iostat > 0, Invalid -E flag option' ! endif ! ! if (cmd_iarg == 0) then ! E_out = 0 !All summary erosion values ! elseif (cmd_iarg == 1) then ! E_out = 1 !Total erosion loss ! elseif (cmd_iarg == 2) then ! E_out = 2 !Saltation/creep ! elseif (cmd_iarg == 3) then ! E_out = 3 !Suspension ! elseif (cmd_iarg == 4) then ! E_out = 4 !PM10 ! else !Invalid option - stop ! STOP 'Invalid -E flag option' ! endif ! endif ! !write(0,*) 'E_out:', E_out !write(0,*) 'input_filepath', trim(input_filepath) !extract input file basename from it's path indx = index(trim(input_filepath),'/',back=.true.) !cut extension from input filename !NOTE: the file must have an extension else it won't work rndx = index(trim(input_filepath),'.',back=.true.) !write(0,*) 'indx and rndx', indx, rndx !write(0,*) 'input_filepath(indx+1:)', trim(input_filepath(indx+1:)) !write(0,*) 'input_filepath(:rndx-1)', trim(input_filepath(:rndx-1)) !write(0,*) trim(input_filepath(indx+1:rndx-1)) !create new output filename with input filename path o_E_file = trim(input_filepath(indx+1:rndx-1)) // & & trim(o_E_ext) o_E_filepath = trim(input_filepath(:rndx-1))//trim(o_E_ext) !write(0,*) 'o_E_file:', trim(o_E_file) !write(0,*) 'o_E_filepath:', trim(o_E_filepath) open(o_E_unit, file=o_E_filepath, IOSTAT=iostat, & & status='unknown') if (iostat /= 0) then write(0,*) 'Erosion summary file:',trim(o_E_filepath) write(0,*) 'iostat', iostat STOP 'Error opening Erosion summary file' endif else !Unknown option .... write (0,*) 'Ignoring uknown option: ', trim(argv) endif 09 continue endif if (o_unit .ne. 6) then open(o_unit, file='erod.out' , status='unknown') endif ! obtain EROSION (standalone) inputs: ! write (*,*) 'call to erodin ' call erodin(i_unit, o_unit) ! Initialize erosion code, create grid, etc: ! (must come after sim field size, & no. subr specified) ! write (*,*) 'call to erodinit ' call erodinit ! ! write (*,*) 'call to erosion ' ! start erosion call erosion (o_unit) ! Print output from standalone EROSION submodel run ! write (*,*) 'call to erodout ' if (am0efl .eq. 1) then call erodout (o_unit, E_out, o_E_unit, o_E_file) endif if (i_unit .ne. 5) then close(i_unit) endif if (o_unit .ne. 6) then close(o_unit) endif close(o_E_unit) !Close Summary Erosion Output file stop end