inicfilemod.f90

来自「CCSM Research Tools: Community Atmospher」· F90 代码 · 共 1,188 行 · 第 1/3 页

#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: