#include <misc.h>#include <preproc.h>module inicFileMod!----------------------------------------------------------------------- ! Purpose: ! read and writes initial data netCDF history files!! Method: ! ! Author: Mariana Vertenstein! !-----------------------------------------------------------------------! $Id: inicFileMod.F90,v 1.10.10.5.6.1 2002/05/13 19:25:06 erik Exp $!-----------------------------------------------------------------------  use precision  use clm_varder  use clm_varmap  , only : begpatch, endpatch, numland, numpatch, &                           landvec,  patchvec, begland, endland  use clm_varpar  , only : nlevsno, nlevsoi, nlevlak, maxpatch, rtmlon, rtmlat  use clm_varcon  , only : spval  use fileutils   , only : getfil#if (defined SPMD)  use spmdMod     , only : masterproc, npes, compute_mpigs_patch, compute_mpigs_land  use mpishorthand, only : mpir8, mpiint, mpilog, mpicom#else  use spmdMod     , only : masterproc#endif#if (defined RTM)  use RtmMod      , only : volr#endif  implicit none! netcdf data  integer, private  :: ncid                !netCDF dataset id  integer, private  :: dimid               !netCDF dimension id   integer, private  :: varid               !netCDF variable id! input dataset dimensions  integer, private  :: numland_dim         !value for [numland] from dataset  integer, private  :: maxpatch_dim        !value for [maxpatch] from dataset  integer, private  :: nlevsoi_dim         !value for [nlevsoi] from dataset  integer, private  :: nlevsno_dim         !value for [nlevsno] from dataset  integer, private  :: nlevtot_dim         !number of total (snow+soil) levels from dataset    integer, private  :: rtmlon_dim          !number of RTM longitudes  integer, private  :: rtmlat_dim          !number of RTM latitudes! methods  public  :: do_inicwrite   private :: patch_to_land   private :: land_to_patch  private :: set_init_filename  INTERFACE patch_to_land     MODULE procedure patch_to_land_1d_int     MODULE procedure patch_to_land_1d_real     MODULE procedure patch_to_land_2d_real  END INTERFACE  INTERFACE land_to_patch     MODULE procedure land_to_patch_1d_int     MODULE procedure land_to_patch_1d_real     MODULE procedure land_to_patch_2d_real  END INTERFACE  SAVE!=======================================================================CONTAINS!=======================================================================  subroutine inicrd ()!----------------------------------------------------------------------- ! ! Purpose: ! read initial data from netCDF instantaneous initial data history file ! for variables:!   snlsno, dzsno, zsno, zisno, h2ocan, h2osno, snowdp, snowage, !   h2osoi_liq, h2osoi_ice, t_veg, t_grnd, t_soisno, t_lake!! Method: ! ! Author: Mariana Vertenstein! !-----------------------------------------------------------------------    use precision    use clm_varctl, only : finidat    implicit none    include 'netcdf.inc'! ------------------------ local variables -----------------------------    integer :: i,j,k,l,m,n        !loop indices    character(len=256) :: locfn   !local file name    integer :: ndim               !input dimension           integer :: ret                !netcdf return code#if (defined SPMD)    integer :: numrecvv(0:npes-1) !vector of items to be received      integer :: displsv(0:npes-1)  !displacement vector    integer :: numsend            !number of items to be sent    integer :: ier                !mpi return code#endif    integer , allocatable :: ibuf1dl(:,:)    integer , allocatable :: ibuf1dp(:)    real(r8), allocatable :: rbuf1dl(:,:)    real(r8), allocatable :: rbuf1dp(:)    real(r8), allocatable :: rbuf2dl(:,:,:)    real(r8), allocatable :: rbuf2dp(:,:)! --------------------------------------------------------------------! Open netCDF data file and read data    if (masterproc) then       call getfil (finidat, locfn, 0)       call wrap_open (locfn, nf_nowrite, ncid)! check input dimensions       call wrap_inq_dimid (ncid, 'numland', dimid)       call wrap_inq_dimlen (ncid, dimid, numland_dim)       if (numland_dim /= numland) then          write (6,*) 'INICRD error: numland values disagree'          write (6,*) 'finidat numland = ',numland_dim,' model numland = ',numland          call endrun       end if       call wrap_inq_dimid (ncid, 'maxpatch', dimid)       call wrap_inq_dimlen (ncid, dimid, maxpatch_dim)       if (maxpatch_dim /= maxpatch) then          write (6,*) 'INICRD error: maxpatch values disagree'          write (6,*) 'finidat maxpatch = ',maxpatch_dim,' model maxpatch = ',maxpatch          call endrun       end if       call wrap_inq_dimid (ncid, 'nlevsno', dimid)       call wrap_inq_dimlen (ncid, dimid, nlevsno_dim)       if (nlevsno_dim /= nlevsno) then          write (6,*) 'INICRD error: nlevsno values disagree'          write (6,*) 'finidat levsno = ',nlevsno_dim,' model nlevsno = ',nlevsno          call endrun       end if       call wrap_inq_dimid (ncid, 'nlevsoi', dimid)       call wrap_inq_dimlen (ncid, dimid, nlevsoi_dim)       if (nlevsoi_dim /= nlevsoi) then          write (6,*) 'INICRD error: nlevsoi values disagree'          write (6,*) 'finidat nlevsoi = ',nlevsoi_dim,' model nlevsoi = ',nlevsoi          call endrun       end if       call wrap_inq_dimid (ncid, 'nlevtot', dimid)       call wrap_inq_dimlen (ncid, dimid, nlevtot_dim)       if (nlevtot_dim /= nlevsoi+nlevsno) then          write (6,*) 'INICRD error: nlevtot values disagree'          write (6,*) 'finidat nlevtot = ',nlevtot_dim,' model nlevtot = ',nlevsno+nlevsoi          call endrun        end if#if (defined RTM)       ret = nf_inq_dimid (ncid, 'rtmlon', dimid)       if (ret == NF_NOERR) then          call wrap_inq_dimlen (ncid, dimid, rtmlon_dim)          if (rtmlon_dim /= rtmlon) then             write (6,*) 'INICRD error: rtmlon values disagree'             write (6,*) 'finidat rtmlon = ',rtmlon_dim,' model rtmlon = ',rtmlon             call endrun          end if       endif       ret = nf_inq_dimid (ncid, 'rtmlat', dimid)       if (ret == NF_NOERR) then          call wrap_inq_dimlen (ncid, dimid, rtmlat_dim)          if (rtmlat_dim /= rtmlat) then             write (6,*) 'INICRD error: rtmlat values disagree'             write (6,*) 'finidat rtmlat = ',rtmlat_dim,' model rtmlat = ',rtmlat             call endrun          end if       endif#endif    endif ! if-masterproc block! Obtain data - for the snow interfaces, are only examing the snow ! interfaces above zi=0 which is why zisno and zsno have the same ! level dimension below    allocate (rbuf1dl(numland,maxpatch))    allocate (ibuf1dl(numland,maxpatch))    allocate (rbuf1dp(begpatch:endpatch))    allocate (ibuf1dp(begpatch:endpatch))        ! Read in zisno    ! NOTE: zi(0) is set to 0 in routine iniTimeConst    allocate (rbuf2dp(-nlevsno+0:-1,begpatch:endpatch))    allocate (rbuf2dl(numland,maxpatch,-nlevsno+0:-1))     if (masterproc) then       call wrap_inq_varid (ncid, 'ZISNO_INI', varid)       call wrap_get_var_realx(ncid, varid, rbuf2dl)    endif    call land_to_patch (rbuf2dl, rbuf2dp, nlevsno)     do k = begpatch,endpatch       clm(k)%zi(-nlevsno+0:-1) = rbuf2dp(-nlevsno+0:-1,k)    end do    deallocate (rbuf2dl)    deallocate (rbuf2dp)        ! Read in zsno    allocate (rbuf2dl(numland,maxpatch,-nlevsno+1:0))    allocate (rbuf2dp(-nlevsno+1: 0,begpatch:endpatch))    if (masterproc) then       call wrap_inq_varid (ncid, 'ZSNO_INI', varid)       call wrap_get_var_realx(ncid, varid, rbuf2dl)    endif    call land_to_patch (rbuf2dl, rbuf2dp, nlevsno)    do k = begpatch,endpatch       clm(k)%z (-nlevsno+1:0) = rbuf2dp(-nlevsno+1:0,k)    end do    deallocate (rbuf2dl)    deallocate (rbuf2dp)        ! Read in dzsno    allocate (rbuf2dl(numland,maxpatch,-nlevsno+1:0))    allocate (rbuf2dp(-nlevsno+1: 0,begpatch:endpatch))    if (masterproc) then       call wrap_inq_varid (ncid, 'DZSNO_INI', varid)       call wrap_get_var_realx(ncid, varid, rbuf2dl)    endif    call land_to_patch (rbuf2dl, rbuf2dp, nlevsno)    do k = begpatch,endpatch       clm(k)%dz(-nlevsno+1:0) = rbuf2dp(-nlevsno+1:0,k)    end do    deallocate (rbuf2dl)    deallocate (rbuf2dp)    ! Read in h2osoi_liq    allocate (rbuf2dl(numland,maxpatch,-nlevsno+1:nlevsoi))     allocate (rbuf2dp(-nlevsno+1:nlevsoi,begpatch:endpatch))    if (masterproc) then       call wrap_inq_varid (ncid, 'H2OSOI_LIQ_INI', varid)       call wrap_get_var_realx(ncid, varid, rbuf2dl)    endif    call land_to_patch (rbuf2dl, rbuf2dp, nlevsno+nlevsoi)    do k = begpatch,endpatch       clm(k)%h2osoi_liq(-nlevsno+1:nlevsoi) = rbuf2dp(-nlevsno+1:nlevsoi,k)    end do    deallocate (rbuf2dl)    deallocate (rbuf2dp)        ! Read in h2osoi_ice    allocate (rbuf2dl(numland,maxpatch,-nlevsno+1:nlevsoi))     allocate (rbuf2dp(-nlevsno+1:nlevsoi,begpatch:endpatch))    if (masterproc) then       call wrap_inq_varid (ncid, 'H2OSOI_ICE_INI', varid)       call wrap_get_var_realx(ncid, varid, rbuf2dl)    endif    call land_to_patch (rbuf2dl, rbuf2dp, nlevsno+nlevsoi)    do k = begpatch,endpatch       clm(k)%h2osoi_ice(-nlevsno+1:nlevsoi) = rbuf2dp(-nlevsno+1:nlevsoi,k)    end do    deallocate (rbuf2dl)    deallocate (rbuf2dp)        ! Read in t_soisno    allocate (rbuf2dl(numland,maxpatch,-nlevsno+1:nlevsoi))     allocate (rbuf2dp(-nlevsno+1:nlevsoi,begpatch:endpatch))    if (masterproc) then       call wrap_inq_varid (ncid, 'T_SOISNO_INI', varid)       call wrap_get_var_realx(ncid, varid, rbuf2dl)    endif    call land_to_patch (rbuf2dl, rbuf2dp, nlevsno+nlevsoi)    do k = begpatch,endpatch       clm(k)%t_soisno(-nlevsno+1:nlevsoi) = rbuf2dp(-nlevsno+1:nlevsoi,k)    end do    deallocate (rbuf2dl)    deallocate (rbuf2dp)        ! Read in t_lake    allocate(rbuf2dl(numland,maxpatch,1:nlevlak))    allocate(rbuf2dp(1:nlevlak,begpatch:endpatch))    if (masterproc) then       call wrap_inq_varid (ncid, 'T_LAKE_INI', varid)       call wrap_get_var_realx(ncid, varid, rbuf2dl)    endif    call land_to_patch (rbuf2dl, rbuf2dp, nlevlak)    do k = begpatch,endpatch       clm(k)%t_lake(1:nlevlak) = rbuf2dp(1:nlevlak,k)    end do    deallocate (rbuf2dl)    deallocate (rbuf2dp)        ! Read in t_veg    if (masterproc) then       call wrap_inq_varid (ncid, 'T_VEG_INI', varid)       call wrap_get_var_realx (ncid, varid, rbuf1dl)    endif    call land_to_patch (rbuf1dl, rbuf1dp)    do k = begpatch,endpatch       clm(k)%t_veg  = rbuf1dp(k)    end do        ! Read in t_grnd    if (masterproc) then       call wrap_inq_varid (ncid, 'T_GRND_INI', varid)       call wrap_get_var_realx (ncid, varid, rbuf1dl)    endif    call land_to_patch (rbuf1dl, rbuf1dp)    do k = begpatch,endpatch       clm(k)%t_grnd = rbuf1dp(k)    end do        ! Read in h2ocan    if (masterproc) then       call wrap_inq_varid (ncid, 'H2OCAN_INI', varid)       call wrap_get_var_realx(ncid, varid, rbuf1dl)    endif    call land_to_patch (rbuf1dl, rbuf1dp)    do k = begpatch,endpatch       clm(k)%h2ocan = rbuf1dp(k)    end do    ! Read in h2osno    if (masterproc) then       call wrap_inq_varid (ncid, 'H2OSNO_INI', varid)       call wrap_get_var_realx(ncid, varid, rbuf1dl)    endif    call land_to_patch (rbuf1dl, rbuf1dp)    do k = begpatch,endpatch       clm(k)%h2osno = rbuf1dp(k)    end do        ! Read in snowdp    if (masterproc) then       call wrap_inq_varid (ncid, 'SNOWDP_INI', varid)       call wrap_get_var_realx(ncid, varid, rbuf1dl)    endif    call land_to_patch (rbuf1dl, rbuf1dp)    do k = begpatch,endpatch       clm(k)%snowdp = rbuf1dp(k)    end do        ! Read in snowage    if (masterproc) then       call wrap_inq_varid (ncid, 'SNOWAGE_INI', varid)       call wrap_get_var_realx(ncid, varid, rbuf1dl)    endif    call land_to_patch (rbuf1dl, rbuf1dp)    do k = begpatch,endpatch       clm(k)%snowage= rbuf1dp(k)    end do        ! Read in snlsno    if (masterproc) then       call wrap_inq_varid (ncid, 'SNLSNO_INI', varid)       call wrap_get_var_int(ncid, varid, ibuf1dl)    endif    call land_to_patch (ibuf1dl, ibuf1dp)    do k = begpatch,endpatch       clm(k)%snl = ibuf1dp(k)    end do#if (defined RTM)    if (masterproc) then       ret = nf_inq_varid (ncid, 'RTMVOLR', varid)       if (ret == NF_NOERR) then          write(6,*)'INICFILE: reading in river volr'          call wrap_get_var_realx(ncid, varid, volr)       endif    endif#endif    deallocate (ibuf1dl)    deallocate (rbuf1dl)    deallocate (ibuf1dp)    deallocate (rbuf1dp)    return  end subroutine inicrd!=======================================================================  subroutine inicwrt ()!----------------------------------------------------------------------- ! Purpose: ! write initial data to netCDF history file!! Method: