c     +++ PURPOSE +++
c     a made up main program useful when modifying sbinpt alone
c     otherwise use tsterode.for for running erosion alone
c     +++ MAIN +++
c      open (55, file='tst.out', status='unknown') c     call sbinpt
c      close (55)
c      stop
c      end
c**********************************************************

c**********************************************************************
c     subroutine sbinpt  ver 98.02
c**********************************************************************
      subroutine sbinpt

c
c     +++ PURPOSE +++
c     Utility to read initial conditions and variables from
c     input file (eros.ipt) ver 98.02 for the erosion submodel
c     Utility to write most variables used by erosion to output file
c
c     +++ ARGUMENT DECLARATIONS +++
c
c
c     +++ ARGUMENT DEFINITIONS +++
c
c
c     +++ PARAMETERS +++
c
c
c     +++ ARGUMENT DECLARATIONS & +++
c     + + + GLOBAL COMMON BLOCKS + + +
*$noreference
      include 'p1werm.inc'
C     include 'p1unconv.inc'
      include 'p1const.inc'
      include 'm1sim.inc'
      include 'm1flag.inc'
      include 'm1subr.inc'
      include 'm1geo.inc'
c     include 'c1gen.inc'
      include 'b1glob.inc'
      include 'b1geom.inc'
      include 's1layr.inc'
      include 's1phys.inc'
      include 's1dbh.inc'
      include 's1agg.inc'
      include 's1surf.inc'
      include 's1sgeo.inc'
      include 'h1db1.inc'
      include 'w1wind.inc'
c     include 'w1pavg.inc'
c
c     + + + LOCAL COMMON BLOCKS + + +
     
c
*$reference
c
c     +++ LOCAL VARIABLES +++
      integer i,j,k
      real f(mntime), wfcalm, wuc, w0k, step
c
c     + + + LOCAL VARIABLE DEFINITIONS + + +
c     i, j, k = do-loop indices
c     f(mntime) = cumulative frequency of wind at speeds <awu(i)
c     wfcalm    = wind fraction intercept (+calm, - no calm in period)
c     wuc       = Weibull wind speed distribution scale factor (m/s)
c     w0k       = Weibull wind speed distribution shape factor
c     step      = tmp real variable for ntstep
c
c     +++ SUBROUTINES CALLED +++
c     sbr
c
c     +++ END SPECIFICATIONS +++
c
c      read  +++ MAIN  COMMON BLOCKS +++
c
      open (unit=2, file='eros.ipt')
      call sbr(18)

c     m1sim.inc  +++ SIMULATION REGION +++
      read (2,*) am0jd, ntstep, amalat, amalon, amzele
      call sbr(3)

c     m1flag.inc
      read (2,*) am0ifl, am0eif, am0cgf, am0cif, am0dif
      call sbr(1)
      read (2,*) am0hfl, am0sfl, am0tfl, am0cfl, am0dfl, am0efl
      call sbr(3)
c     m1subr.inc
      read (2,*) nsubr, am0csr, (am0irr(i),i=1,nsubr),
     &  (amrslp(i), i=1,nsubr)
      call sbr(3)
c      
c     m1geo.inc
      read (2,*) nacctr, nbr, amasim
            call sbr(1)
    
      read (2,*) (((amxar (i,j,k), i=1,2), j=1,2), k=1,nacctr)
      
c
      if (nbr .gt. 0) then
         call sbr(1)
         do 3  k = 1, nbr
    3    read (2,*) ((amxbr(i,j,k), i=1,2), j=1,2)
         call sbr(1)
c      
  
         do 4 k = 1,nbr
    4    read (2,*)  amzbr(k), ampbr(k), amxbrw(k)
      else
         call sbr(4)
      endif
c         
      call sbr(1)
      read (2,*) ((amxsim (i,j), i=1,2),j=1,2)
      call sbr(1)
      read (2,*) (((amxsr (i,j,k), i=1,2),j=1,2),k=1,nsubr)
c ^^^ tmp
c      go to 500 
c     read   +++ BIOMASS +++
      call sbr(3)

c    not used
c     c1gen.inc
c      do 3  i=1, nsubr
c    3 read (2,*) ac0rg(i), acxrow(i), acdpop(i)
c      call sbr(3)

c     b1glob.inc
      do 5   i=1,nsubr
    5 read (2,*) abzht(i), abz(i), abzrtd(i), abmst(i), abmrt(i),
     & abrahi(i)
      call sbr(3)

c     b1geom.inc
      do 10  i=1, nsubr
   10 read (2,*) abrsai(i), abrlai(i),
     & (abrsaz(j,i), j=1,1), (abrlaz(j,i), j=1,1)
c
      call sbr(1)
      do 11 i=1, nsubr
   11  read (2,*) abffcv(i), abfscv(i), abftcv(i)
    
c     read   +++ SOIL +++
      call sbr(3)
      
c     s1layr.inc
      read (2,*) (nslay(i), i=1,nsubr)
      call sbr(1)
      do 20 j=1,nsubr
   20 read (2,*) (aszlyt(i,j),i=1,nslay(j))
      call sbr(3)
c     s1phys.inc
      do 30 j=1,nsubr
   30 read (2,*) (asdblk(i,j), i=1,nslay(j))
      call sbr(3)
     
c     s1dbh.inc
      do 40  j=1, nsubr
   40 read (2,*) (asfsan(i,j), i=1,3 )
c     i=1,nslay(j))
      call sbr(1)

      do 50 j=1,nsubr
   50 read (2,*) (asfsil(i,j), i=1,nslay(j))
      call sbr(1)
      do 60 j=1,nsubr
   60 read (2,*)(asfcla(i,j), i=1, nslay(j))
      call sbr(1)
      do 70 j=1,nsubr
   70 read (2,*)(asvroc(i,j), i=1, nslay(j))
      call sbr(3)
     
c     s1agg.inc
      do 75 j=1,nsubr
      k = j
   75 read (2,*) (asdagd(i,j), i=1,nslay(k))
      call sbr(1)
      do 80 j=1, nsubr
   80 read (2,*) (aseags(i,j),i=1,nslay(j))
      call sbr(1)
     
      do 90 j=1,nsubr
   90 read (2,*)(aslagm(i,j),i=1,nslay(j))
      call sbr(1)

      do 100 j=1,nsubr
  100 read (2,*)(aslagn(i,j), i=1,nslay(j))
      call sbr(1)

      do 110 j=1,nsubr
  110 read (2,*)(aslagx(i,j), i=1,nslay(j))
      call sbr(1)
      do 120 j=1,nsubr
  120 read (2,*)(as0ags(i,j), i=1,nslay(j))
      call sbr(3)
    
c     s1surf.inc
      do 130 i=1,nsubr
  130 read (2,*)aszcr(i), asfcr(i), asmlos(i), asflos(i),
     &  asdcr(i), asecr(i)
      call sbr(1)
      do 135 i = 1,nsubr
  135 read (2,*) asfald(i), asfalw(i)
      call sbr(3)

c     s1sgeo.inc
      do 140 i=1,nsubr
  140    read(2,*) aszrgh(i), asxrgw(i), asxrgs(i), asargo(i),
     &          asxdks(i), aslrr(i)
     
      call sbr(3)
     
c     read   +++ HYDROLOGY +++

c     h1db1.inc
      do 160 j = 1,nsubr
  160 read (2,*) (ahrwcw(i,j), i=1,nslay(j))
      call sbr(1)

      do 170 j = 1,nsubr
  170 read (2,*) (ahrwcf(i,j), i=1,nslay(j))
      call sbr(1)

      do 180 j = 1,nsubr
  180 read (2,*) (ahrwca(i,j), i=1,nslay(j))
      call sbr(1)
      do 190 j = 1,nsubr
  190 read (2,*)(ahrwcs(i,j), i=1,nslay(j))
       call sbr(1)

      do 195 j = 1,nsubr
  195 read (2,*)(ahrwc0(i,j), i=1,24)
      call sbr(2)
      
      read (2,*) (ahzsnd(i), i = 1,nsubr)
      call sbr(3)
c     read   +++ WEATHER +++
      
c     w1pavg.inc  skip
c     read (2,*) awtmmx, awtmmn, awadir, awztpt,awtpav,awepir
      call sbr(1)
c     read (2,*) awupav, awnurt, aweuet
      call sbr(2)
      call sbr(3)

c     w1wind.inc
c
c     wind data inputs as the Weibull paramters
c     (wfcalm, wuc, w0k) is indicated by code ntstep = 99
      
      if (ntstep .eq. 99) then
         read (2,*) awadir
         call sbr(1)
         read (2,*) wfcalm, wuc, w0k, ntstep
c ^^^ tmp
c         write(*,*) 'wfcalm=', wfcalm, wuc, w0k, ntstep 
c        
c     calculate daily max wind speed
         awudmx = wuc*(-log((1-0.99)/(1-wfcalm)))**(1/w0k)
c ^^^ tmp
c         write(*,*) 'awudmx=', awudmx
c         
c     calculate period wind speeds
         step = ntstep
         do 198 i= 1, ntstep
c          find center of each step and add empirical last term from 
c                  file ntstep.mcd         
           f(i) = (1./(2.*step)) + ((i-1)/step) +0.3/(step*w0k)
           
c ^^^ tmp
c        write(*,*) 'i=', i, '  f(i)=', f(i), 'ntstep=', ntstep
c          
c            to prevent out-of-range           
             if (f(i) .lt. wfcalm) then
                 f(i) = wfcalm
             endif    
           awu(i) = wuc*(-log((1-f(i))/(1-wfcalm)))**(1/w0k)
c ^^^tmp
c         write(*,*) 'f(i)=', f(i), '  awu(i)=', awu(i)           
  198 continue
          awudmx = awu(ntstep)
c  
c     when ntstep .ne. 99 read input wind period data directly
      else
         read (2,*) awadir, awrmxn, awhrmx, awudmx, awudmn, awudav
          call sbr(3)
          read (2,*) (awu(i),i=1,ntstep)
      endif 
      
c     + + + OUTPUT SECTION + + + 
c
c     can skip output, if desired
c     go to 900
c
  200 format (1x, f6.2, 6f8.2)
  350 format (1x, i3, 6f6.0)
  300 format (1x, 8i5)
  400 format (1x, i3, 1x, l6, 4x, i3, 4x, i3, 4x, i3, 4x, f6.0)
  
c ^^^ tmp
c  500 continue
c   
      write (55,*)  '        REPORT OF INPUTS (read/write by sbinpt) '
      write (55,*)  '+++ SIMULATION REGION +++'
c 
      write (55,*) 'ntstep  am0eif  nsubr  nacctr  nbr  amasim'
      write (55,400) ntstep, am0eif, nsubr, nacctr, nbr, amasim
c
      if (nbr .gt. 0) then
         write (55,*)  
         write (55,*) 'amxbr    (start and end of each barrier)  '
         write (55,200) (((amxbr(i,j,k), i=1,2), j=1,2), k=1,nbr)
       
         write (55,*) 'amzbr     ampbr   amxbrw '
         do 750 k = 1, nbr
  750    write (55,200) amzbr(k), ampbr(k), amxbrw(k)
       else 
         write (55,*) ' no barriers'
       endif  
c      write (55,*) 
      write (55,*) 'amasim  amxsim  (angle & corners of sim region)'
      write (55,200) amasim,  ((amxsim(i,j), i=1,2), j=1,2)
c
c ^^^ tmp
c      go to 900 
c
      write (55,*)  
      write(55,*) '+++ BIOMASS +++'
      write (55,*) 'abzht     abrsai  abrlai  abffcv  '
      do 800 i=1,nsubr
  800 write (55,200) abzht(i), abrsai(i), abrlai(i), abffcv(i)
c
      write (55,*) 
      write (55,*) '+++ SOIL +++ '
      write (55,*) 'nslay      aszlyt    '
      do 810 j=1,nsubr
  810 write (55,350) nslay(j), (aszlyt(i,j), i=1,nslay(j))
c
c      write (55,*) 
      write (55,*) 'asdblk '
      do 820 j=1,nsubr
  820 write (55,200) (asdblk(i,j), i=1,nslay(j)) 
c
c      write (55,*)  
      write (55,*) 'For top layer and subregion 1 '
      write (55,*) 'asfsan    asfsil  asfcla   asvroc '
      write (55,200) asfsan(1,1), asfsil(1,1), asfcla(1,1), asvroc(1,1)            
c
      write (55,*) 
      write (55,*) 'asdagd    aseags  aslagm  aslagn  aslagx  as0ags'
      write (55,200) asdagd(1,1), aseags(1,1), aslagm(1,1), aslagn(1,1),
     & aslagx(1,1), as0ags(1,1) 
c 
      write (55,*)     
      write (55,*) 'asfcr     asmlos  asflos  asdcr  asecr '
      do 830 i= 1,nsubr
  830 write (55,200) asfcr(i), asmlos(i), asflos(i), asdcr(i), asecr(i)
c 
      write (55,*)  
      write (55,*) 'aszrgh    asxrgw  asxrgs asargo  asxdks  aslrr' 
      do 840 i=1,nsubr    
  840 write (55,200) aszrgh(i), asxrgw(i), asxrgs(i), asargo(i),
     & asxdks(i), aslrr(i)    
c
      write (55,*) 
      write (55,*) '+++ HYDROLOGY +++ '    
      write (55,*) 'ahrwcw    ahrwca  ahrwc0  ahzsnd '
      do 850 i=1,nsubr
  850 write (55,200) ahrwcw(1,i), ahrwca(1,i), ahrwc0(24,i), ahzsnd(i)    
c
      write (55,*)  
      write(55,*) '+++ WEATHER +++'
      write (55,*) ' awadir   awudmx'
      write(55,200)  awadir, awudmx
c      
      write (55,*) 'awu (ntstep) '
      k = 6
      j = 1
  860 if((k) .lt. ntstep) then
        write (55,200) (awu(i), i=j,k)
        j = k+1
        k = k+6
        go to 860
      else
        k = ntstep
        write (55,200) (awu(i), i=j,k)
      endif      
      write (55,*) 'END OF INPUTS'
c
c     use continue if skip report section      
  900 continue
c
      close (unit=2)
      return
      end
c++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

c**********************************************************************
c**********************************************************************
      subroutine sbr(n)
c**********************************************************************
c
c     +++ PURPOSE +++
c     skips 'n' comment lines in the input file
c
      integer n,i
      do 10 i = 1,n 
      read (2,*)
   10 continue
      return
      end
c++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++