c file: 'input.for' subroutine input c + + + PURPOSE + + + c This subroutine perforns some screen I/O, reads in the c run files and performs various error checkings. c author: John Tatarko c version: 95.08 C EDIT History C 06-Feb-99 wjr changed crop_db, etc., location C to be scenario dir C 06-Feb-99 wjr made inprun and inpsub into separate subrs C 06-Feb-99 wjr used select statement to read config files C 06-Feb-99 wjr moved opening of sinfil from inprun to inpsub C 06-Feb-99 wjr changed files.inc to file.fi C 06-Feb-99 wjr added luolog & luodbg c + + + KEY WORDS + + + c WEPS, cligen, windgen c + + + GLOBAL COMMON BLOCKS + + + *$noereference include 'p1werm.inc' include 'wpath.inc' include 'm1subr.inc' include 'm1sim.inc' include 'm1geo.inc' include 'm1flag.inc' include 'm1dbug.inc' include 's1layr.inc' include 's1surf.inc' include 's1phys.inc' include 's1agg.inc' include 's1dbh.inc' include 's1dbc.inc' include 's1layd.inc' include 's1sgeo.inc' include 'c1gen.inc' include 'c1glob.inc' include 'd1glob.inc' include 'd1gen.inc' include 'h1hydro.inc' include 'h1scs.inc' include 'h1db1.inc' include 'file.fi' c + + + LOCAL COMMON BLOCKS + + + include 'main/main.inc' *$reference c + + + LOCAL VARIABLES + + + integer isr, ip, l integer arglen integer argc integer g_argc character arg*256 logical fexist c + + + LOCAL DEFINITIONS + + + c amo*fl - These are switches for production of submodel c output, where the asterisk represents the first c letter of the submodel name. c *infil - These character variables hold the run file names c where the asterisk represents the first c letter of the submodel name. c clifil - This variable holds the CLIGEN input file name. c genrpt - This variable holds flags to select the various general c report forms. c i - Generic loop counter. c id,im,iy - The initial day, month, and year of simulation. c ijday - This variable contains the initial julian day of c the simulation run. c isr - This variable holds the subregion index. c l - This variable is a index on soil layers. c ip - This variable is a index on decomp pools. c lchar - This variable holds the character position in a string c so to ignore leading blanks in that string. c ld,lm,ly - The last day, month, and year of simulation. c ljday - This variable contains the last julian day of c the simulation run. c nslay - The number of soil layers. c nsubr - This variable holds the total number of subregions. c runfil - This variable holds the simulation run input file name. c series - This character variable holds the soil series name. c simout - This variable holds the simulation output file name. c sinfil - This variable holds the SOIL/HYDROLOGY input file name. c subfil - This variable holds the subdaily wind information c ('real data') file name for use by subroutine 'calcwu'. c usrid - This character variable is an identification string c to aid the user in identifying the simulation run. c usrloc - This character variable holds a location c description of the simulation site. c usrnam - This character variable holds the user name. c winfil - This variable holds the WINDGEN input file name. c arglen - This variable holds size of the specified cmdline argument c envlen - This variable holds size of the specified env variable string c + + + FUNCTION DECLARATIONS + + + c integer julday integer g_argv integer lentrm c + + + FUNCTIONS CALLED + + + c julday - This function determines the julian day given day, c month, and year. c g_argv - This function extracts specified commandline argument c c lentrm - This function determines length of a string c (up to last non-blank char in a non-compiler specific call) c + + + DATA INITIALIZATIONS + + + c + + + INPUT FORMATS + + + c + + + OUTPUT FORMATS + + + 2010 format (////////,30x,' W E P S',//,21x,' WIND EROSION PREDIC &TION SYSTEM',//,32x,'USDA - ARS',///,27x,' RELEASE 98.01 ',//// &////,' Press ''control - break'' to halt execution at any time',/) 2020 format (///////////) 2210 format (a80,/,' already exists - press enter to overwrite this fil &e or control break to stop') 2270 format (/,' using the sub-daily wind file: ',a80) 2500 format (1x,'PROBLEM READING SIMULATION RUN FILE - EXECUTION HALTED & IOSTAT=',i20) 2520 format (1x,'PROBLEM READING THE INITIAL FIELD CONDITION FILE - EXE &CUTION HALTED') 2530 format (1x,'PROBLEM READING THE MANAGEMENT RUN FILE - EXECUTION HA <ED') c + + + END SPECIFICATIONS + + + C Note that all paths MUST end with a "/" for now. C WEPS root directory rootp = './' print *, 'rootp is: ', rootp(1:lentrm(rootp)) write(luolog, *) 'rootp is: ', rootp(1:lentrm(rootp)) c ++++++ code for commandline specification of runfile +++++ c Determine number of commandline arguments (excluding cmd path/name) argc = g_argc() if (argc .eq. 1) then arglen = g_argv (1, arg) rootp = arg(1:arglen) // '/' endif write(luolog, *) 'Using ', rootp(1:lentrm(rootp)), & ' as the simulation input directory' c open simulation run file runfil = rootp(1:lentrm(rootp)) // 'weps.run' inquire(file = runfil(1:lentrm(runfil)), exist = fexist) if (.not.fexist) then stop ' simulation run file not found ' end if C load the simulation run file call inprun C load sub-region data call inpsub do 50, isr = 1, nsubr c to be provided by other run files or submodels (they are needed c for this version) am0irr(isr) = 0.0 ahzirr(isr) = 0.0 c need to check to see if any of these variables are being initialized c elsewhere first - LEW C crop pool variables aczht(isr) = 0.0 aczrtd(isr) = 0.0 acm(isr) = 0.0 acmst(isr) = 0.0 acmrt(isr) = 0.0 acmyld(isr) = 0.0 acdstm(isr) = 0.0 acrsai(isr) = 0.0 acrlai(isr) = 0.0 acffcv(isr) = 0.0 acfscv(isr) = 0.0 acftcv(isr) = 0.0 do 20 l = 1, nslay(isr) acmrtz(l,isr) = 0.0 20 continue do 25 l = 1, mncz acrsaz(l,isr) = 0.0 acrlaz(l,isr) = 0.0 25 continue C decomp pool variables do 40 ip=1,mnbpls adzht(ip,isr) = 0.0 adm(ip,isr) = 0.0 admst(ip,isr) = 0.0 admf(ip,isr) = 0.0 admbg(ip,isr) = 0.0 admrt(ip,isr) = 0.0 addstm(ip,isr) = 0.0 adrsai(ip,isr) = 0.0 adrlai(ip,isr) = 0.0 adffcv(ip,isr) = 0.0 adfscv(ip,isr) = 0.0 adftcv(ip,isr) = 0.0 do 30 l=1,nslay(isr) admbgz(l,ip,isr) = 0.0 admrtz(l,ip,isr) = 0.0 30 continue do 35 l=1, mncz adrsaz(l,ip,isr) = 0.0 adrlaz(l,ip,isr) = 0.0 35 continue 40 continue 50 continue end