#include <misc.h> #include <preproc.h> !----------------------------------------------------------------------- !BOP ! ! !ROUTINE: snowdp2lev ! ! !INTERFACE: subroutine snowdp2lev(lbc, ubc) 1,3 ! ! !DESCRIPTION: ! Create snow layers and interfaces given snow depth. ! Note that cps%zi(0) is set in routine iniTimeConst. ! ! !USES: use shr_kind_mod, only : r8 => shr_kind_r8 use clmtype use clm_varpar , only : nlevsno ! ! !ARGUMENTS: implicit none integer, intent(in) :: lbc, ubc ! column bounds ! ! !REVISION HISTORY: ! Created by Mariana Vertenstein ! ! !LOCAL VARIABLES: ! ! local pointers to implicit in arguments ! integer , pointer :: clandunit(:) ! landunit index associated with each column real(r8), pointer :: snowdp(:) ! snow height (m) logical , pointer :: lakpoi(:) ! true => landunit is a lake point ! ! local pointers to implicit out arguments ! integer , pointer :: snl(:) ! number of snow layers real(r8), pointer :: z(:,:) ! layer depth (m) over snow only real(r8), pointer :: dz(:,:) ! layer thickness depth (m) over snow only real(r8), pointer :: zi(:,:) ! interface depth (m) over snow only ! ! ! !LOCAL VARIABLES: !EOP integer :: c,l,j !indices !----------------------------------------------------------------------- ! Assign local pointers to derived subtypes components (landunit-level) lakpoi => clm3%g%l%lakpoi ! Assign local pointers to derived type members (column-level) clandunit => clm3%g%l%c%landunit snowdp => clm3%g%l%c%cps%snowdp snl => clm3%g%l%c%cps%snl zi => clm3%g%l%c%cps%zi dz => clm3%g%l%c%cps%dz z => clm3%g%l%c%cps%z ! Initialize snow levels and interfaces (lake and non-lake points) !dir$ concurrent !cdir nodep do c = lbc, ubc dz(c,-nlevsno+1: 0) = 1.e36_r8 z (c,-nlevsno+1: 0) = 1.e36_r8 zi(c,-nlevsno :-1) = 1.e36_r8 end do ! Determine snow levels and interfaces for non-lake points !dir$ concurrent !cdir nodep do c = lbc,ubc l = clandunit(c) if (.not. lakpoi(l)) then if (snowdp(c) < 0.01_r8) then snl(c) = 0 dz(c,-nlevsno+1:0) = 0._r8 z (c,-nlevsno+1:0) = 0._r8 zi(c,-nlevsno+0:0) = 0._r8 else if ((snowdp(c) >= 0.01_r8) .and. (snowdp(c) <= 0.03_r8)) then snl(c) = -1 dz(c,0) = snowdp(c) else if ((snowdp(c) > 0.03_r8) .and. (snowdp(c) <= 0.04_r8)) then snl(c) = -2 dz(c,-1) = snowdp(c)/2._r8 dz(c, 0) = dz(c,-1) else if ((snowdp(c) > 0.04_r8) .and. (snowdp(c) <= 0.07_r8)) then snl(c) = -2 dz(c,-1) = 0.02_r8 dz(c, 0) = snowdp(c) - dz(c,-1) else if ((snowdp(c) > 0.07_r8) .and. (snowdp(c) <= 0.12_r8)) then snl(c) = -3 dz(c,-2) = 0.02_r8 dz(c,-1) = (snowdp(c) - 0.02_r8)/2._r8 dz(c, 0) = dz(c,-1) else if ((snowdp(c) > 0.12_r8) .and. (snowdp(c) <= 0.18_r8)) then snl(c) = -3 dz(c,-2) = 0.02_r8 dz(c,-1) = 0.05_r8 dz(c, 0) = snowdp(c) - dz(c,-2) - dz(c,-1) else if ((snowdp(c) > 0.18_r8) .and. (snowdp(c) <= 0.29_r8)) then snl(c) = -4 dz(c,-3) = 0.02_r8 dz(c,-2) = 0.05_r8 dz(c,-1) = (snowdp(c) - dz(c,-3) - dz(c,-2))/2._r8 dz(c, 0) = dz(c,-1) else if ((snowdp(c) > 0.29_r8) .and. (snowdp(c) <= 0.41_r8)) then snl(c) = -4 dz(c,-3) = 0.02_r8 dz(c,-2) = 0.05_r8 dz(c,-1) = 0.11_r8 dz(c, 0) = snowdp(c) - dz(c,-3) - dz(c,-2) - dz(c,-1) else if ((snowdp(c) > 0.41_r8) .and. (snowdp(c) <= 0.64_r8)) then snl(c) = -5 dz(c,-4) = 0.02_r8 dz(c,-3) = 0.05_r8 dz(c,-2) = 0.11_r8 dz(c,-1) = (snowdp(c) - dz(c,-4) - dz(c,-3) - dz(c,-2))/2._r8 dz(c, 0) = dz(c,-1) else if (snowdp(c) > 0.64_r8) then snl(c) = -5 dz(c,-4) = 0.02_r8 dz(c,-3) = 0.05_r8 dz(c,-2) = 0.11_r8 dz(c,-1) = 0.23_r8 dz(c, 0)=snowdp(c)-dz(c,-4)-dz(c,-3)-dz(c,-2)-dz(c,-1) endif end if end if end do ! The following loop is currently not vectorized do c = lbc,ubc l = clandunit(c) if (.not. lakpoi(l)) then do j = 0, snl(c)+1, -1 z(c,j) = zi(c,j) - 0.5_r8*dz(c,j) zi(c,j-1) = zi(c,j) - dz(c,j) end do end if end do ! Determine snow levels and interfaces for lake points !dir$ concurrent !cdir nodep do c = lbc,ubc l = clandunit(c) if (lakpoi(l)) then snl(c) = 0 dz(c,-nlevsno+1:0) = 0._r8 z (c,-nlevsno+1:0) = 0._r8 zi(c,-nlevsno+0:0) = 0._r8 end if end do end subroutine snowdp2lev