cbl_surfbv.F90 Source File


This file depends on

sourcefile~~cbl_surfbv.f90~~EfferentGraph sourcefile~cbl_surfbv.f90 cbl_surfbv.F90 sourcefile~cable_common.f90 cable_common.F90 sourcefile~cbl_surfbv.f90->sourcefile~cable_common.f90 sourcefile~cable_surface_types.f90 cable_surface_types.F90 sourcefile~cbl_surfbv.f90->sourcefile~cable_surface_types.f90 sourcefile~cbl_smoisturev.f90 cbl_smoisturev.F90 sourcefile~cbl_surfbv.f90->sourcefile~cbl_smoisturev.f90 sourcefile~cbl_soilsnow_data.f90 cbl_soilsnow_data.F90 sourcefile~cbl_surfbv.f90->sourcefile~cbl_soilsnow_data.f90 sourcefile~cable_runtime_opts_mod.f90 cable_runtime_opts_mod.F90 sourcefile~cable_common.f90->sourcefile~cable_runtime_opts_mod.f90 sourcefile~cbl_smoisturev.f90->sourcefile~cable_common.f90 sourcefile~cbl_smoisturev.f90->sourcefile~cbl_soilsnow_data.f90 sourcefile~cbl_trimb.f90 cbl_trimb.F90 sourcefile~cbl_smoisturev.f90->sourcefile~cbl_trimb.f90 sourcefile~cbl_soilsnow_data.f90->sourcefile~cable_common.f90 sourcefile~cable_define_types.f90 cable_define_types.F90 sourcefile~cbl_soilsnow_data.f90->sourcefile~cable_define_types.f90 sourcefile~cable_phys_constants_mod.f90 cable_phys_constants_mod.F90 sourcefile~cbl_soilsnow_data.f90->sourcefile~cable_phys_constants_mod.f90 sourcefile~cable_climate_type_mod.f90 cable_climate_type_mod.F90 sourcefile~cable_define_types.f90->sourcefile~cable_climate_type_mod.f90 sourcefile~cbl_trimb.f90->sourcefile~cbl_soilsnow_data.f90 sourcefile~cable_climate_type_mod.f90->sourcefile~cable_common.f90 sourcefile~grid_constants_cbl.f90 grid_constants_cbl.F90 sourcefile~cable_climate_type_mod.f90->sourcefile~grid_constants_cbl.f90

Files dependent on this one

sourcefile~~cbl_surfbv.f90~~AfferentGraph sourcefile~cbl_surfbv.f90 cbl_surfbv.F90 sourcefile~cbl_soilsnow_main.f90 cbl_soilsnow_main.F90 sourcefile~cbl_soilsnow_main.f90->sourcefile~cbl_surfbv.f90 sourcefile~cbl_model_driver_offline.f90 cbl_model_driver_offline.F90 sourcefile~cbl_model_driver_offline.f90->sourcefile~cbl_soilsnow_main.f90 sourcefile~cable_mpimaster.f90 cable_mpimaster.F90 sourcefile~cable_mpimaster.f90->sourcefile~cbl_model_driver_offline.f90 sourcefile~cable_mpiworker.f90 cable_mpiworker.F90 sourcefile~cable_mpiworker.f90->sourcefile~cbl_model_driver_offline.f90 sourcefile~cable_serial.f90 cable_serial.F90 sourcefile~cable_serial.f90->sourcefile~cbl_model_driver_offline.f90 sourcefile~cable_offline_driver.f90 cable_offline_driver.F90 sourcefile~cable_offline_driver.f90->sourcefile~cable_serial.f90

Source Code

MODULE surfbv_mod

USE cbl_ssnow_data_mod

PUBLIC  surfbv

CONTAINS 

SUBROUTINE surfbv (dels, met, ssnow, soil, veg, canopy )
! subrs
USE smoisturev_mod,          ONLY: smoisturev

! data
USE cable_surface_types_mod, ONLY: lakes_cable
USE cable_common_module

IMPLICIT NONE

    REAL, INTENT(IN) :: dels ! integration time step (s)

    TYPE(canopy_type), INTENT(IN)       :: canopy

    TYPE(met_type),       INTENT(INOUT) :: met    ! all met forcing
    TYPE(soil_snow_type), INTENT(INOUT) :: ssnow  ! soil+snow variables

    TYPE(veg_parameter_type),  INTENT(IN)     :: veg
    TYPE(soil_parameter_type), INTENT(INOUT)  :: soil  ! soil parameters

    !jhan:cable.nml
    INTEGER :: nglacier = 0  ! 0 original, 1 off, 2 new Eva

    REAL, DIMENSION(mp) ::                                                      &
         rnof5,      & !
         sgamm,      & !
         smasstot,   & !
         talb,       & ! snow albedo
         tmp           ! temporary value
    REAL(r_2), DIMENSION(mp) :: xxx

    REAL, DIMENSION(mp,0:3) :: smelt1

    REAL :: wb_lake_T, rnof2_T, ratio
    INTEGER :: k,j

    IF( .NOT. cable_runtime%UM  .OR. cable_runtime%esm15 ) THEN
       nglacier = 2
    ENDIF

    CALL smoisturev( dels, ssnow, soil, veg )

    DO k = 1, ms
       xxx = REAL( soil%ssat,r_2 )
       ssnow%rnof1 = ssnow%rnof1 + REAL( MAX( ssnow%wb(:,k) - xxx, 0.0_r_2 )  &
            * 1000.0 )  * soil%zse(k)
       ssnow%wb(:,k) = MAX( 0.01_r_2, MIN( ssnow%wb(:,k), xxx ) )
    END DO

    ! for deep runoff use wb-sfc, but this value not to exceed .99*wb-wbice
    ! account for soil/ice cracking
    ! fracm = MIN(0.2, 1. - MIN(1., ssnow%wb(:,ms) / soil%sfc ) )
    ! ssnow%wb(:,ms) = ssnow%wb(:,ms) &
    !                  + fracm*ssnow%rnof1/(1000.0*soil%zse(ms))
    ! ssnow%rnof1 = (1. - fracm) * ssnow%rnof1

    ! Scaling  runoff to kg/m^2/s to match rest of the model
    !jhan:replace nested wheres

    !---  glacier formation
    rnof5= 0.

    IF (nglacier == 2) THEN

       smelt1=0.
       WHERE( ssnow%snowd > max_glacier_snowd )

          rnof5 = MIN( 0.1, ssnow%snowd - max_glacier_snowd )

          !---- change local tg to account for energy - clearly not best method
          WHERE( ssnow%isflag == 0 )
             smasstot = 0.0
             ssnow%tgg(:,1) = ssnow%tgg(:,1) - rnof5 * CHLF                    &
                  / REAL( ssnow%gammzz(:,1) )
             ssnow%snowd = ssnow%snowd - rnof5
          ELSEWHERE
             smasstot = ssnow%smass(:,1) + ssnow%smass(:,2) + ssnow%smass(:,3)
          END WHERE

       END WHERE

       DO k = 1, 3

          WHERE( ssnow%snowd > max_glacier_snowd  .AND.  ssnow%isflag > 0 )
             sgamm = ssnow%ssdn(:,k) * Ccgsnow * ssnow%sdepth(:,k)
             smelt1(:,k) = MIN( rnof5 * ssnow%smass(:,k) / smasstot,            &
                  0.2 * ssnow%smass(:,k) )
             ssnow%smass(:,k) = ssnow%smass(:,k) - smelt1(:,k)
             ssnow%snowd = ssnow%snowd - smelt1(:,k)
          END WHERE

       END DO

       WHERE( ssnow%isflag > 0 ) rnof5 = smelt1(:,1) + smelt1(:,2) + smelt1(:,3)

    END IF

    !  Rescale drainage to remove water added to lakes (wb_lake)
    ssnow%sinfil = 0.0
    WHERE( veg%iveg == lakes_cable )
       ssnow%sinfil  = MIN( ssnow%rnof1, ssnow%wb_lake ) ! water that can be extracted from the rnof1
       ssnow%rnof1   = MAX( 0.0, ssnow%rnof1 - ssnow%sinfil )
       ssnow%wb_lake = MAX( 0.0, ssnow%wb_lake - ssnow%sinfil)
       ssnow%sinfil  = MIN( ssnow%rnof2, ssnow%wb_lake ) ! water that can be extracted from the rnof2
       ssnow%rnof2   = MAX( 0.0, ssnow%rnof2 - ssnow%sinfil )
       ssnow%wb_lake = MAX( 0.0, ssnow%wb_lake - ssnow%sinfil)
       xxx = MAX(0.0_r_2, (ssnow%wb(:,ms) - REAL(soil%sfc(:),r_2))*soil%zse(ms)*1000.0)
       ssnow%sinfil  = MIN( REAL(xxx), ssnow%wb_lake )
       ssnow%wb(:,ms) = ssnow%wb(:,ms) - REAL(ssnow%sinfil / (soil%zse(ms)*1000.0), r_2)
       ssnow%wb_lake = MAX( 0.0, ssnow%wb_lake - ssnow%sinfil)
       xxx = MAX(0.0_r_2, (ssnow%wb(:,ms) - 0.5*(soil%sfc + soil%swilt))*soil%zse(ms)*1000.0)
       ssnow%sinfil  = MIN( REAL(xxx), ssnow%wb_lake )
       ssnow%wb(:,ms) = ssnow%wb(:,ms) - ssnow%sinfil / (soil%zse(ms)*1000.0)
       ssnow%wb_lake = MAX( 0.0, ssnow%wb_lake - ssnow%sinfil)
    ENDWHERE

    !wb_lake_T = sum( ssnow%wb_lake )
    !rnof2_T = sum( ssnow%rnof2 )
    !ratio = min( 1., wb_lake_T/max(rnof2_T,1.))
    !ssnow%rnof2 = ssnow%rnof2 - ratio*ssnow%rnof2
    !ssnow%wb_lake = MAX( 0.0, ssnow%wb_lake - ratio*ssnow%rnof2)

    !  Rescale drainage to remove water added to lakes (wb_lake)
    !wb_lake_T = 0.0
    !rnof2_T = 0.
    !DO j=1,mp
    !   IF( ssnow%wb_lake(j) >  0.0 ) wb_lake_T = wb_lake_T + ssnow%wb_lake(j)
    !   rnof2_T = rnof2_T + ssnow%rnof2(j)
    !END DO
    !ratio = min( 1., wb_lake_T/max(rnof2_T,1.))
    !ssnow%rnof2 = ssnow%rnof2 - ratio*ssnow%rnof2
    !ssnow%wb_lake = MAX( 0.0, ssnow%wb_lake - ratio*ssnow%rnof2)

    ssnow%rnof1 = ssnow%rnof1 / dels + rnof5/dels
    ssnow%rnof2 = ssnow%rnof2 / dels
    ssnow%runoff = ssnow%rnof1 + ssnow%rnof2

  END SUBROUTINE surfbv

END MODULE surfbv_mod