cbl_snowAccum.F90 Source File


This file depends on

sourcefile~~cbl_snowaccum.f90~~EfferentGraph sourcefile~cbl_snowaccum.f90 cbl_snowAccum.F90 sourcefile~cable_common.f90 cable_common.F90 sourcefile~cbl_snowaccum.f90->sourcefile~cable_common.f90 sourcefile~cbl_soilsnow_data.f90 cbl_soilsnow_data.F90 sourcefile~cbl_snowaccum.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_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~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_snowaccum.f90~~AfferentGraph sourcefile~cbl_snowaccum.f90 cbl_snowAccum.F90 sourcefile~cbl_soilsnow_main.f90 cbl_soilsnow_main.F90 sourcefile~cbl_soilsnow_main.f90->sourcefile~cbl_snowaccum.f90 sourcefile~cbl_thermal.f90 cbl_thermal.F90 sourcefile~cbl_thermal.f90->sourcefile~cbl_snowaccum.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 snow_accum_mod

USE cbl_ssnow_data_mod

PUBLIC  snow_accum

CONTAINS 


SUBROUTINE snow_accum ( dels,  canopy, met, ssnow, soil )
USE cable_common_module
IMPLICIT NONE

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

    TYPE(canopy_type), INTENT(INOUT)         :: canopy ! vegetation variables
    TYPE(met_type), INTENT(INOUT)            :: met   ! all met forcing
    TYPE(soil_snow_type), INTENT(INOUT)      :: ssnow ! soil+snow variables
    TYPE(soil_parameter_type), INTENT(INOUT) :: soil ! soil parameters

    REAL, DIMENSION(mp) ::                                                      &
         osm,     & !
         sgamm,   & !
         snowmlt, & !
         xxx        !

    INTEGER             :: i,j,k

    DO i=1,mp

       IF(canopy%precis(i) > 0.0 .AND. ssnow%isflag(i) == 0) THEN

          ! accumulate solid part
          ssnow%snowd(i) = MAX( ssnow%snowd(i) + met%precip_sn(i), 0.0 )

          canopy%precis(i) = canopy%precis(i) - met%precip_sn(i)

          ssnow%ssdn(i,1) = MAX( 120.0, ssnow%ssdn(i,1)                            &
               * ssnow%osnowd(i) / MAX( 0.01, ssnow%snowd(i) )              &
               + 120.0 * met%precip_sn(i) / MAX( 0.01, ssnow%snowd(i) ) )

          ssnow%ssdnn(i) = ssnow%ssdn(i,1)

          IF( canopy%precis(i) > 0.0 .AND. ssnow%tgg(i,1) < CTFRZ ) THEN

             ssnow%snowd(i) = MAX(ssnow%snowd(i) + canopy%precis(i), 0.0)

             ssnow%tgg(i,1) = ssnow%tgg(i,1) + canopy%precis(i) * CHLF               &
                  / ( REAL( ssnow%gammzz(i,1) ) + Ccswat *canopy%precis(i) )
             ! change density due to water being added
             ssnow%ssdn(i,1) = MIN( max_ssdn, MAX( 120.0, ssnow%ssdn(i,1)          &
                  * ssnow%osnowd(i) / MAX( 0.01, ssnow%snowd(i) ) + Cdensity_liq  &
                  * canopy%precis(i) / MAX( 0.01, ssnow%snowd(i) )  ) )

             ! permanent ice: fix hard-wired number in next version
             IF( soil%isoilm(i) /= 9 )                                             &
                  ssnow%ssdn(i,1) = MIN( 450.0, ssnow%ssdn(i,1) )

             canopy%precis(i) = 0.0
             ssnow%ssdnn(i) = ssnow%ssdn(i,1)

          END IF

       END IF ! (canopy%precis > 0. .and. ssnow%isflag == 0)

       IF(canopy%precis(i) > 0.0 .AND.  ssnow%isflag(i) > 0) THEN

          ! add solid precip
          ssnow%snowd(i) = MAX( ssnow%snowd(i) + met%precip_sn(i), 0.0 )

          canopy%precis(i) = canopy%precis(i) - met%precip_sn(i)  ! remaining liquid precip

          ! update top snow layer with fresh snow
          osm(i) = ssnow%smass(i,1)
          ssnow%smass(i,1) = ssnow%smass(i,1) + met%precip_sn(i)
          ssnow%ssdn(i,1) = MAX( 120.0,ssnow%ssdn(i,1) * osm(i) / ssnow%smass(i,1)    &
               + 120.0 * met%precip_sn(i) / ssnow%smass(i,1) )

          ssnow%sdepth(i,1) = MAX( 0.02, ssnow%smass(i,1) / ssnow%ssdn(i,1) )

          ! add liquid precip
          IF( canopy%precis(i) > 0.0 ) THEN

             ssnow%snowd(i) = MAX( ssnow%snowd(i) + canopy%precis(i), 0.0 )
             sgamm(i) = ssnow%ssdn(i,1) * Ccgsnow * ssnow%sdepth(i,1)
             osm(i) = ssnow%smass(i,1)

             ssnow%tggsn(i,1) = ssnow%tggsn(i,1) + canopy%precis(i) * CHLF           &
                  * osm(i) / (sgamm(i) * ssnow%osnowd(i) )
             ssnow%smass(i,1) = ssnow%smass(i,1) + canopy%precis(i)                   &
                  * osm(i)/ssnow%osnowd(i)

             ssnow%ssdn(i,1) = MAX( 120.0, MIN( ssnow%ssdn(i,1) * osm(i) /            &
                  ssnow%smass(i,1) +  Cdensity_liq *                        &
                  ( 1.0 - osm(i) / ssnow%smass(i,1) ), max_ssdn ) )

             ! permanent ice: fix hard-wired number in next version
             IF( soil%isoilm(i) /= 9 ) &
                  ssnow%ssdn(i,1) = MIN( 450.0, ssnow%ssdn(i,1) )

             ssnow%sdepth(i,1) = ssnow%smass(i,1)/ssnow%ssdn(i,1)

             !layer 2
             sgamm(i) = ssnow%ssdn(i,2) * Ccgsnow * ssnow%sdepth(i,2)
             osm(i) = ssnow%smass(i,2)
             ssnow%tggsn(i,2) = ssnow%tggsn(i,2) + canopy%precis(i) * CHLF           &
                  * osm(i) / ( sgamm(i) * ssnow%osnowd(i) )
             ssnow%smass(i,2) = ssnow%smass(i,2) + canopy%precis(i)                   &
                  * osm(i) / ssnow%osnowd(i)
             ssnow%ssdn(i,2) = MAX( 120.0, MIN( ssnow%ssdn(i,2) * osm(i) /            &
                  ssnow%smass(i,2) + Cdensity_liq *                         &
                  ( 1.0 - osm(i) / ssnow%smass(i,2) ), max_ssdn ) )

             ! permanent ice: fix hard-wired number in next version
             IF( soil%isoilm(i) /= 9 ) &
                  ssnow%ssdn(i,2) = MIN( 450.0, ssnow%ssdn(i,2) )

             ssnow%sdepth(i,2) = ssnow%smass(i,2) / ssnow%ssdn(i,2)

             !layer 3
             sgamm(i) = ssnow%ssdn(i,3) * Ccgsnow * ssnow%sdepth(i,3)
             osm(i) = ssnow%smass(i,3)
             ssnow%tggsn(i,3) = ssnow%tggsn(i,3) + canopy%precis(i) * CHLF           &
                  * osm(i) / ( sgamm(i) * ssnow%osnowd(i) )
             ssnow%smass(i,3) = ssnow%smass(i,3) + canopy%precis(i)                   &
                  * osm(i) / ssnow%osnowd(i)
             ssnow%ssdn(i,3) = MAX( 120.0, MIN( ssnow%ssdn(i,3) * osm(i) /             &
                  ssnow%smass(i,3) + Cdensity_liq *                          &
                  ( 1.0 - osm(i) / ssnow%smass(i,3) ), max_ssdn ) )

             ! permanent ice: fix hard-wired number in next version
             IF( soil%isoilm(i) /= 9 ) &
                  ssnow%ssdn(i,3) = MIN(450.0,ssnow%ssdn(i,3))

             ssnow%sdepth(i,3) = ssnow%smass(i,3) / ssnow%ssdn(i,3)

             canopy%precis(i) = 0.0

          ENDIF

       ENDIF

    ENDDO

    ! 'fess' is for soil evap and 'fes' is for soil evap plus soil puddle evap
    canopy%segg = canopy%fess / CHL
    canopy%segg = ( canopy%fess + canopy%fes_cor ) / CHL

    ! Initialise snow evaporation:
    ssnow%evapsn = 0
    DO i=1,mp
       ! Snow evaporation and dew on snow
       ! NB the conditions on when %fes applies to %segg or %evapsn MUST(!)
       ! match those used to set %cls in the latent_heat_flux calculations
       ! for moisture conservation purposes
       ! Ticket 137 - using %cls as the trigger not %snowd
       IF( ssnow%cls(i) == 1.1335 ) THEN
          !WHERE( ssnow%snowd > 0.1 )

          ssnow%evapsn(i) = dels * ( canopy%fess(i) + canopy%fes_cor(i) ) / ( CHL + CHLF )
          xxx(i) = ssnow%evapsn(i)

          IF( ssnow%isflag(i) == 0 .AND. canopy%fess(i) + canopy%fes_cor(i).GT. 0.0 )    &
               ssnow%evapsn(i) = MIN( ssnow%snowd(i), xxx(i) )

          IF( ssnow%isflag(i)  > 0 .AND. canopy%fess(i) + canopy%fes_cor(i) .GT. 0.0 )   &
               ssnow%evapsn(i) = MIN( 0.9 * ssnow%smass(i,1), xxx(i) )

          ssnow%snowd(i) = ssnow%snowd(i) - ssnow%evapsn(i)

          IF( ssnow%isflag(i) > 0 ) THEN
             ssnow%smass(i,1) = ssnow%smass(i,1)  - ssnow%evapsn(i)
             ssnow%sdepth(i,1) = MAX( 0.02, ssnow%smass(i,1) / ssnow%ssdn(i,1) )
          ENDIF

          canopy%segg(i) = 0.0

          !INH: cls package
          !we still need to conserve moisture/energy when evapsn is limited
          !this is a key point of moisture non-conservation

       ENDIF

    ENDDO

END SUBROUTINE snow_accum

END MODULE snow_accum_mod