INTERFACE:
subroutine create_clm_s2x(clm_s2x)DESCRIPTION:
Assign values to clm_s2x based on the appropriate derived types
USES:
use clm_varctl , only : glc_smb use clmtype , only : clm3 use domainMod , only : ldomain use clm_varcon , only : istice_mec use clm_atmlnd , only : clm_l2a, clm_a2l use clm_varcon , only : spvalARGUMENTS:
implicit none type(lnd2glc_type), intent(out) :: clm_s2xREVISION HISTORY:
Written by William Lipscomb, Feb. 2009
integer :: begg, endg ! per-proc beginning and ending gridcell indices
integer :: begc, endc ! per-proc beginning and ending column indices
integer :: c, l, g, n ! indices
integer , pointer :: ityplun(:) ! landunit type
integer , pointer :: clandunit(:) ! column's landunit index
integer , pointer :: cgridcell(:) ! column's gridcell index
! Assign local pointers to derived type members
clandunit => clm3%g%l%c%landunit
cgridcell => clm3%g%l%c%gridcell
ityplun => clm3%g%l%itype
! Get processor bounds
call get_proc_bounds(begg, endg, begc=begc, endc=endc)
! initialize to be safe
clm_s2x%tsrf(:,:) = 0._r8
clm_s2x%topo(:,:) = 0._r8
clm_s2x%qice(:,:) = 0._r8
! fill the clm_s2x vector on the clm grid
if (glc_smb) then ! send surface mass balance info
do c = begc, endc
l = clandunit(c)
g = cgridcell(c)
if (ityplun(l) == istice_mec) then
n = c - clm3%g%l%coli(l) + 1 ! elevation class index
! (assumes all elevation classes are populated)
clm_s2x%tsrf(g,n) = clm3%g%l%c%ces%t_soisno(c,1)
clm_s2x%qice(g,n) = clm3%g%l%c%cwf%qflx_glcice(c)
clm_s2x%topo(g,n) = clm3%g%l%c%cps%glc_topo(c)
! Check for bad values of qice
if ( abs(clm_s2x%qice(g,n)) > 1.0_r8 .and. clm_s2x%qice(g,n) /= spval) then
write(iulog,*) 'WARNING: qice out of bounds: g, n, qice =', g, n, clm_s2x%qice(g,n)
endif
endif ! istice_mec
enddo ! c
else ! Pass PDD info (same info in each elevation class)
! It might make sense to require glc_nec = 1 for this case
do n = 1, glc_nec
do g = begg, endg
clm_s2x%tsrf(g,n) = clm_l2a%t_ref2m(g)
clm_s2x%qice(g,n) = clm_a2l%forc_snow(g) ! Assume rain runs off
clm_s2x%topo(g,n) = ldomain%topo(g)
! Check for bad values of qice
if (clm_s2x%qice(g,n) > -1.0_r8 .and. clm_s2x%qice(g,n) < 1.0_r8) then
continue
else
write(iulog,*) 'WARNING: qice out of bounds: g, n, qice =', g, n, clm_s2x%qice(g,n)
write(iulog,*) 'forc_rain =', clm_a2l%forc_rain(g)
write(iulog,*) 'forc_snow =', clm_a2l%forc_snow(g)
endif
enddo
enddo
endif ! glc_smb
end subroutine create_clm_s2x
------------------------------------------------------------------------------
%/////////////////////////////////////////////////////////////
\mbox{}\hrulefill\
\subsubsection [unpack\_clm\_x2s] {unpack\_clm\_x2s}
\bigskip{\sf INTERFACE:}
\begin{verbatim} subroutine unpack_clm_x2s(clm_x2s)
DESCRIPTION:
Unpack clm_x2s and update the appropriate derived types
USES:
use clm_varcon , only : istice_mec use clmtype , only : clm3ARGUMENTS:
implicit none type(glc2lnd_type), intent(in) :: clm_x2sREVISION HISTORY:
Written by William Lipscomb, Feb. 2009
integer :: begc, endc ! per-proc beginning and ending column indices
integer :: c, l, g, n ! indices
integer , pointer :: ityplun(:) ! landunit type
integer , pointer :: clandunit(:) ! column's landunit index
integer , pointer :: cgridcell(:) ! column's gridcell index
logical :: update_glc2sno_fields ! if true, update glacier_mec fields
! Assign local pointers to derived type members
clandunit => clm3%g%l%c%landunit
cgridcell => clm3%g%l%c%gridcell
ityplun => clm3%g%l%itype
update_glc2sno_fields = .false.
if (update_glc2sno_fields) then
do c = begc, endc
l = clandunit(c)
g = cgridcell(c)
if (ityplun(l) == istice_mec) then
n = c - clm3%g%l%coli(l) + 1 ! elevation class index
clm3%g%l%c%cps%glc_frac(c) = clm_x2s%frac(g,n)
clm3%g%l%c%cps%glc_topo(c) = clm_x2s%topo(g,n)
clm3%g%l%c%cwf%glc_rofi(c) = clm_x2s%rofi(g,n)
clm3%g%l%c%cwf%glc_rofl(c) = clm_x2s%rofl(g,n)
clm3%g%l%c%cef%eflx_bot(c) = clm_x2s%hflx(g,n)
endif
enddo
endif ! update fields
end subroutine unpack_clm_x2s
------------------------------------------------------------------------
end module clm_glclnd
\markboth{Left}{Source File: clm\_initializeMod.F90, Date: Wed Jun 15 14:32:17 MDT 2011
}
module clm_initializeMod
-----------------------------------------------------------------------
%/////////////////////////////////////////////////////////////
\mbox{}\hrulefill\
\subsection{Fortran: Module Interface clm\_initializeMod (Source File: clm\_initializeMod.F90)}
Performs land model initialization
\bigskip{\em USES:}
\begin{verbatim} use shr_kind_mod , only : r8 => shr_kind_r8
use spmdMod , only : masterproc
use shr_sys_mod , only : shr_sys_flush
use abortutils , only : endrun
use clm_varctl , only : nsrest, nsrStartup, nsrContinue, nsrBranch, downscale
use clm_varctl , only : iulog
use clm_varctl , only : create_glacier_mec_landunit
use clm_varsur , only : wtxy,vegxy
use clm_varsur , only : topoxy
use clmtype , only : gratm, grlnd, nameg, namel, namec, namep, allrof
use perf_mod , only : t_startf, t_stopf
use ncdio_pio
use mct_mod
PUBLIC TYPES:
implicit none save private ! By default everything is privatePUBLIC MEMBER FUNCTIONS:
public :: initialize1 ! Phase one initialization public :: initialize2 ! Phase two initializationREVISION HISTORY:
Created by Gordon Bonan, Sam Levis and Mariana VertensteinPRIVATE MEMBER FUNCTIONS:
private header ! echo version numbers private do_restread ! read a restart file private cellarea ! area of grid cells (square km) ----------------------------------------------------------------------- !PRIVATE DATA MEMBERS: None