module inicPerpMod !----------------------------------------------------------------------- !BOP ! ! !MODULE: inicPerpMod ! ! !DESCRIPTION: ! Read initial data for perpetual mode ! ! !USES: use shr_kind_mod , only : r8 => shr_kind_r8 use spmdMod , only : mpicom, MPI_CHARACTER, masterproc, MPI_LOGICAL use abortutils , only : endrun use clm_varctl , only : iulog use ncdio_pio ! !PUBLIC TYPES: implicit none save ! ! !PUBLIC MEMBER FUNCTIONS: public :: inicPerp ! ! !REVISION HISTORY: ! Jan/2004 Mariana Vertenstein: Creation ! Jan/2010 Li Xu: Modified to correct ncd_io and snow_fraction ! !EOP !----------------------------------------------------------------------- contains !------------------------------------------------------------------------ !BOP ! ! !IROUTINE: inicPerp ! ! !INTERFACE: subroutine inicPerp ! ! !DESCRIPTION: ! Read perpetual initial data fields ! ! !USES: use clmtype use clm_varctl , only : finidat use clm_varpar , only : nlevsno, nlevgrnd, nlevsoi, nlevlak use clm_varcon , only : denice, denh2o, zlnd, isturb use fileutils , only : getfil use decompMod , only : get_proc_bounds, get_proc_global use fileutils , only : getfil use shr_sys_mod , only : shr_sys_flush ! ! !ARGUMENTS: implicit none ! ! !REVISION HISTORY: ! ! ! !LOCAL VARIABLES: !EOP type(file_desc_t) :: ncid ! netcdf id integer :: j,c,l ! indices integer :: begp, endp ! per-proc beginning and ending pft indices integer :: begc, endc ! per-proc beginning and ending column indices integer :: begl, endl ! per-proc beginning and ending landunit indices integer :: begg, endg ! per-proc gridcell ending gridcell indices integer :: numg,numl,numc,nump ! total numbers logical :: readvar ! determine if variable is on initial file integer :: ier ! error status type(gridcell_type), pointer :: gptr ! pointer to gridcell derived subtype type(landunit_type), pointer :: lptr ! pointer to landunit derived subtype type(column_type) , pointer :: cptr ! pointer to column derived subtype type(pft_type) , pointer :: pptr ! pointer to pft derived subtype integer , pointer :: clandunit(:) ! landunit index associated with each column integer , pointer :: itypelun(:) ! landunit type character(len=256), save :: loc_fni ! local finidat name logical, save :: opened_finidat = .false. ! true => finidat was opened for read character(len= 32) :: subname='inicfile_perp' ! subroutine name !------------------------------------------------------------------------ ! Assign local pointers to derived subtypes components itypelun => clm3%g%l%itype clandunit => clm3%g%l%c%landunit gptr => clm3%g lptr => clm3%g%l cptr => clm3%g%l%c pptr => clm3%g%l%c%p ! Determine necessary processor subgrid bounds call get_proc_bounds(begg, endg, begl, endl, begc, endc, begp, endp) call get_proc_global(numg, numl, numc, nump) ! Read initial dataset if (.not. opened_finidat) then call getfil(finidat, loc_fni, 0) call ncd_pio_openfile(ncid, trim(loc_fni), 0) if (masterproc) then write(iulog,*)trim(subname),': opened netcdf file ',loc_fni call shr_sys_flush(iulog) end if call check_dim(ncid, 'gridcell', numg) call check_dim(ncid, 'landunit', numl) call check_dim(ncid, 'column' , numc) call check_dim(ncid, 'pft' , nump) call check_dim(ncid, 'levsno' , nlevsno) call check_dim(ncid, 'levgrnd' , nlevgrnd) call check_dim(ncid, 'levlak' , nlevlak) opened_finidat = .true. call mpi_bcast (opened_finidat, 1, MPI_LOGICAL, 0, mpicom, ier) else call ncd_pio_openfile(ncid, trim(loc_fni), 0) end if call ncd_io(varname='ZSNO', data=cptr%cps%z, dim1name=namec, & lowerb2=-nlevsno+1, upperb2=0, ncid=ncid, flag='read', readvar=readvar) if (.not. readvar) call endrun() call ncd_io(varname='DZSNO', data=cptr%cps%dz, dim1name=namec, & lowerb2=-nlevsno+1, upperb2=0, ncid=ncid, flag='read', readvar=readvar) if (.not. readvar) call endrun() call ncd_io(varname='ZISNO', data=cptr%cps%zi, dim1name=namec, & lowerb2=-nlevsno, upperb2=-1, ncid=ncid, flag='read', readvar=readvar) if (.not. readvar) call endrun() call ncd_io(varname='H2OSNO', data=cptr%cws%h2osno, dim1name=namec, & ncid=ncid, flag='read', readvar=readvar) if (.not. readvar) call endrun() call ncd_io(varname='SNOWDP', data=cptr%cps%snowdp, dim1name=namec, & ncid=ncid, flag='read', readvar=readvar) if (.not. readvar) call endrun() call ncd_io(varname='SNLSNO', data=cptr%cps%snl, dim1name=namec, & ncid=ncid, flag='read', readvar=readvar) if (.not. readvar) call endrun() call ncd_io(varname='H2OSOI_LIQ', data=cptr%cws%h2osoi_liq, dim1name=namec, & ncid=ncid, flag='read', readvar=readvar) if (.not. readvar) call endrun() call ncd_io(varname='H2OSOI_ICE', data=cptr%cws%h2osoi_ice, dim1name=namec, & ncid=ncid, flag='read', readvar=readvar) if (.not. readvar) call endrun() call ncd_pio_closefile(ncid) ! Determine volumetric soil water do j = 1,nlevsoi do c = begc,endc l = cptr%landunit(c) if (.not. lptr%lakpoi(l)) then cptr%cws%h2osoi_vol(c,j) = cptr%cws%h2osoi_liq(c,j)/(cptr%cps%dz(c,j)*denh2o) & +cptr%cws%h2osoi_ice(c,j)/(cptr%cps%dz(c,j)*denice) end if end do end do ! ============================================================================ ! ! Fraction of soil covered by snow (Z.-L. Yang U. Texas) ! ============================================================================ do c = begc,endc l = clandunit(c) if (itypelun(l) == isturb) then ! Urban landunit use Bonan 1996 (LSM Technical Note) cptr%cps%frac_sno(c) = min( cptr%cps%snowdp(c)/0.05_r8, 1._r8) else ! snow cover fraction in Niu et al. 2007 cptr%cps%frac_sno(c) = 0.0_r8 if ( cptr%cps%snowdp(c) > 0.0_r8 ) then cptr%cps%frac_sno(c) = tanh(cptr%cps%snowdp(c)/(2.5_r8*zlnd* & (min(800._r8,cptr%cws%h2osno(c)/cptr%cps%snowdp(c))/100._r8)**1._r8) ) endif end if end do end subroutine inicPerp end module inicPerpMod