soil_curve_number Subroutine

  1. soil.f95
  2. soil
  3. soil_curve_number

public subroutine soil_curve_number(cnn, j, je, hsumfc, hsumul)

Arguments

Type IntentOptional AttributesName
real(kind=dp), intent(in) :: cnn
integer, intent(in) :: j
integer, intent(in) :: je
real(kind=dp), intent(in), dimension(:, :):: hsumfc
real(kind=dp), intent(in), dimension(:, :):: hsumul

Called by

proc~~soil_curve_number~~CalledByGraph proc~soil_curve_number soil_curve_number proc~hydrotope_process hydrotope_process proc~hydrotope_process->proc~soil_curve_number proc~runsubbasin runsubbasin proc~runsubbasin->proc~hydrotope_process proc~time_process_day time_process_day proc~time_process_day->proc~runsubbasin proc~time_process_month time_process_month proc~time_process_month->proc~time_process_day proc~time_process_years time_process_years proc~time_process_years->proc~time_process_month program~swim swim program~swim->proc~time_process_years

Contents

Source Code

soil_curve_number

Source Code

  subroutine soil_curve_number(cnn, j, je, hsumfc, hsumul)
    !**** PURPOSE: TO SET CURVE NUMBER PARAMETERS
    !**** CALLED IN: HYDROTOP
    !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    !     PARAMETERS & VARIABLES
    !
    !      >>>>> COMMON PARAMETERS & VARIABLES
    !      cnn = Curve Number = cn2(k, n), from readsol, with title
    !      cnum1 = init. CN for cropland, cond 1
    !      cnum3 = init. CN for cropland, cond 3
    !      hsumfc(j, je) = sum of field capacity in soil, calc in subbasin, mm
    !      hsumul(j, je) = sum of upper limit water content in soil,
    !                     calc in subbasin, mm
    !      icn = switch code for CN: 0 - CN dif for soils,
    !                                         1 - CN=const from cnum1, cnum3
    !      icurn = switch code to print from curn()
    !      icursb = number of subbasin to print from curn(), if icurn = 1
    !      ida = current day
    !      smx(j, je) = retention factor, corresponding cn1
    !      wf(2, j, je) = shape parameters for calc. of retention
    !      >>>>>

    !      >>>>> STATIC PARAMETERS
    !      c2 = local par
    !      cn1 = CN, conditions 1
    !      cn3 = CN, conditions 3
    !      s3 = local par
    !      yy = local par
    !      zz = local par
    !      >>>>>
    !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    !**** Include common parameters

    real(dp), dimension(:, :), intent(in) :: hsumfc
    real(dp), dimension(:, :), intent(in) :: hsumul
    integer, intent(in) :: j, je
    ! cnn = cn2(k, n)
    real(dp), intent(in) :: cnn
    real(dp) :: c2, cn1, cn3, s3, yy, zz

    !**** CALC cn1, cn3
    if (icn .eq. 0) then
      c2 = cnn * cnn
      cn1 = - 16.911 + 1.3481 * cnn - .013793 * c2 + .00011772 * c2 * cnn
      cn3 = cnn * exp(.006729 * (100. - cnn))
    else
      cn1 = cnum1
      cn3 = cnum3
    endif

    !**** CALC retention factor smx()
    smx(j, je) = 254. * (100. / cn1 - 1.)
    s3 = 254. * (100. / cn3 - 1.)

    !**** CALC shape parameters for CN method wf(1, ) and wf(2, )
    yy = hsumfc(j, je) / (1. - s3 / smx(j, je)) - hsumfc(j, je)
    if (yy .ne. 0.) then
      zz =log(yy)
      wf(2, j, je) = (zz -log(hsumul(j, je) / (1. - 2.54 / smx(j, je)) &
        - hsumul(j, je))) / (hsumul(j, je) - hsumfc(j, je))
      wf(1, j, je) = zz + wf(2, j, je) * hsumfc(j, je)
    else
      wf(2, j, je) = 0.
      wf(1, j, je) = 0.
    endif

    return
  end subroutine soil_curve_number