inicfilemod.f90

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

! 
! Author: Mariana Vertenstein
!-----------------------------------------------------------------------

    use precision
    use clm_varctl, only : caseid, ctitle, version, fsurdat
    use time_manager, only : get_nstep
    use fileutils, only : set_filename, putfil
    use clm_varctl, only : archive_dir, mss_wpass, mss_irt
    implicit none
    include 'netcdf.inc'

! ------------------------ local variables ---------------------------
    integer :: i,j,k,l,m,n                     !loop indices
    integer :: dim1_id(1)                      !netCDF dimension id for 1-d variables   
    integer :: dim2_id(2)                      !netCDF dimension id for 2-d variables
    integer :: dim3_id(3)                      !netCDF dimension id for 3-d variables
    integer :: omode                           !netCDF dummy variable
    integer :: status                          !netCDF error status
    character(len=256) :: loc_fn               !local 
    character(len=256) :: rem_dir              !remote (archive) directory
    character(len=256) :: rem_fn               !remote (archive) filename
    character(len=256) :: str                  !global attribute string 
    character(len=256) :: name                 !name of attribute
    character(len=256) :: unit                 !units of attribute
    character(len=256) :: mode                 !field mode (aver, inst, max, min, etc)
    character(len=  8) :: curdate              !current date
    character(len=  8) :: curtime              !current time 
    integer :: snlsno_id                       !netCDF variable id
    integer :: dzsno_id                        !netCDF variable id 
    integer :: zsno_id                         !netCDF variable id
    integer :: zisno_id                        !netCDF variable id
    integer :: h2osoi_liq_id                   !netCDF variable id 
    integer :: h2osoi_ice_id                   !netCDF variable id
    integer :: t_soisno_id                     !netCDF variable id  
    integer :: t_lake_id                       !netCDF variable id  
    integer :: t_veg_id                        !netCDF variable id
    integer :: t_grnd_id                       !netCDF variable id
    integer :: h2ocan_id                       !netCDF variable id
    integer :: h2osno_id                       !netCDF variable id  
    integer :: snowdp_id                       !netCDF variable id
    integer :: snowage_id                      !netCDF variable id    
#if (defined RTM)
    integer :: volr_id                         !netCDF variable id
#endif
    integer , allocatable :: ibuf1dl(:,:)
    integer , allocatable :: ibuf1dp(:)
    real(r8), allocatable :: rbuf1dl(:,:)
    real(r8), allocatable :: rbuf1dp(:)
    real(r8), allocatable :: rbuf2dl(:,:,:)
    real(r8), allocatable :: rbuf2dp(:,:)
! --------------------------------------------------------------------

! --------------------------------------------------------------------
! create initial conditions file for writing
! --------------------------------------------------------------------

    if (masterproc) then

       loc_fn = set_init_filename()
       write(6,*)
       write(6,*)'(INICFILEMOD): Writing clm2 initial conditions dataset at ',&
            trim(loc_fn), 'at nstep = ',get_nstep()
       write(6,*)

! create new netCDF file (in defined mode)

       call wrap_create (trim(loc_fn), nf_clobber, ncid)

! set fill mode to "no fill" to optimize performance

       status = nf_set_fill (ncid, nf_nofill, omode)
       if (status /= nf_noerr) then
          write (6,*) ' netCDF error = ',nf_strerror(status)
          call endrun
       end if

! define dimensions 

       call wrap_def_dim (ncid, 'numland'  , numland        ,numland_dim)
       call wrap_def_dim (ncid, 'maxpatch' , maxpatch       ,maxpatch_dim)
       call wrap_def_dim (ncid, 'nlevsno'  , nlevsno        ,nlevsno_dim)
       call wrap_def_dim (ncid, 'nlevsoi'  , nlevsoi        ,nlevsoi_dim)
       call wrap_def_dim (ncid, 'nlevtot'  , nlevsno+nlevsoi,nlevtot_dim)
#if (defined RTM)
       call wrap_def_dim (ncid, 'rtmlon'   , rtmlon         ,rtmlon_dim)
       call wrap_def_dim (ncid, 'rtmlat'   , rtmlat         ,rtmlat_dim)
#endif

! define global attributes

       str = 'CF1.0'
       call wrap_put_att_text (ncid, NF_GLOBAL, 'conventions', trim(str))
       
       call datetime(curdate, curtime)
       str = 'created on ' // curdate // ' ' // curtime
       call wrap_put_att_text (ncid, NF_GLOBAL,'history', trim(str))
       
       call getenv ('LOGNAME', str)
       call wrap_put_att_text (ncid, NF_GLOBAL, 'logname',trim(str))
       
       call getenv ('HOST', str)
       call wrap_put_att_text (ncid, NF_GLOBAL, 'host', trim(str))
       
       str = 'Community Land Model: CLM2'
       call wrap_put_att_text (ncid, NF_GLOBAL, 'source', trim(str))
       
       str = '$Name: cam2_0_brnchT_release3 $' 
       call wrap_put_att_text (ncid, NF_GLOBAL, 'version', trim(str))
       
       str = '$Id: inicFileMod.F90,v 1.10.10.5.6.1 2002/05/13 19:25:06 erik Exp $'
       call wrap_put_att_text (ncid, NF_GLOBAL, 'revision_id', trim(str))
       
       str = ctitle 
       call wrap_put_att_text (ncid,nf_global,'case_title',trim(str))

       str = caseid
       call wrap_put_att_text (ncid,nf_global,'case_id',trim(str))

! define current date

       mode = 'instantaneous initial conditions'

       name = 'current date as 8 digit integer (YYYYMMDD)'
       call wrap_def_var (ncid, 'mcdate', nf_int, 0, 0, varid)
       call wrap_put_att_text (ncid, varid, 'long_name',name)
       call wrap_put_att_text (ncid, varid, 'mode'     ,mode)

       name = 'current seconds of current date'
       unit = 's'
       call wrap_def_var (ncid, 'mcsec',  nf_int, 0, 0, varid)
       call wrap_put_att_text (ncid, varid, 'long_name',name)
       call wrap_put_att_text (ncid, varid, 'units'    ,unit)
       call wrap_put_att_text (ncid, varid, 'mode'     ,mode)

! define single-level fields (numland x maxpatch)

       dim2_id(1) = numland_dim; dim2_id(2) = maxpatch_dim
       name = 'vegetation temperature (T_VEG)'
       unit = 'K'
       call wrap_def_var (ncid, 'T_VEG_INI', nf_double, 2, dim2_id, t_veg_id)
       call wrap_put_att_text (ncid, t_veg_id, 'long_name',name)
       call wrap_put_att_text (ncid, t_veg_id, 'units'    ,unit)
       call wrap_put_att_text (ncid, t_veg_id, 'mode'     ,mode)

       dim2_id(1) = numland_dim; dim2_id(2) = maxpatch_dim
       name = 'ground temperature (T_GRND)'
       unit = 'K'
       call wrap_def_var (ncid, 'T_GRND_INI', nf_double, 2, dim2_id, t_grnd_id)
       call wrap_put_att_text (ncid, t_grnd_id, 'long_name',name)
       call wrap_put_att_text (ncid, t_grnd_id, 'units'    ,unit)
       call wrap_put_att_text (ncid, t_grnd_id, 'mode'     ,mode)

       dim2_id(1) = numland_dim; dim2_id(2) = maxpatch_dim
       name = 'canopy water (H2OCAN)'
       unit = 'kg/m2'
       call wrap_def_var (ncid, 'H2OCAN_INI', nf_double, 2, dim2_id, h2ocan_id)
       call wrap_put_att_text (ncid, h2ocan_id, 'long_name',name)
       call wrap_put_att_text (ncid, h2ocan_id, 'units'    ,unit)
       call wrap_put_att_text (ncid, h2ocan_id, 'mode'     ,mode)

       dim2_id(1) = numland_dim; dim2_id(2) = maxpatch_dim
       name = 'snow water (H2OSNO)'
       unit = 'kg/m2'
       call wrap_def_var (ncid, 'H2OSNO_INI', nf_double, 2, dim2_id, h2osno_id)
       call wrap_put_att_text (ncid, h2osno_id, 'long_name',name)
       call wrap_put_att_text (ncid, h2osno_id, 'units'    ,unit)
       call wrap_put_att_text (ncid, h2osno_id, 'mode'     ,mode)

       dim2_id(1) = numland_dim; dim2_id(2) = maxpatch_dim
       name = 'snow depth (SNOWDP)'
       unit = 'm'
       call wrap_def_var (ncid, 'SNOWDP_INI', nf_double, 2, dim2_id, snowdp_id)
       call wrap_put_att_text (ncid, snowdp_id, 'long_name',name)
       call wrap_put_att_text (ncid, snowdp_id, 'units'    ,unit)
       call wrap_put_att_text (ncid, snowdp_id, 'mode'     ,mode)

       dim2_id(1) = numland_dim; dim2_id(2) = maxpatch_dim
       name = 'snow age (SNOWAGE)'
       call wrap_def_var (ncid, 'SNOWAGE_INI', nf_double, 2, dim2_id, snowage_id)
       call wrap_put_att_text (ncid, snowage_id, 'long_name',name)
       call wrap_put_att_text (ncid, snowage_id, 'mode'     ,mode)

       dim2_id(1) = numland_dim; dim2_id(2) = maxpatch_dim
       name = 'number of snow layers (SNLSNO)'
       call wrap_def_var (ncid, 'SNLSNO_INI', nf_int, 2, dim2_id, snlsno_id)
       call wrap_put_att_text (ncid, snlsno_id, 'long_name',name)
       call wrap_put_att_text (ncid, snlsno_id, 'mode'     ,mode)

! define multi-level fields (numland x maxpatch x numlev)

       dim3_id(1) = numland_dim; dim3_id(2) = maxpatch_dim; dim3_id(3) = nlevtot_dim
       name = 'soil-snow temperature'
       unit = 'K'
       call wrap_def_var (ncid, 'T_SOISNO_INI', nf_double, 3, dim3_id, t_soisno_id)
       call wrap_put_att_text (ncid, t_soisno_id, 'long_name',name)
       call wrap_put_att_text (ncid, t_soisno_id, 'units'    ,unit)
       call wrap_put_att_text (ncid, t_soisno_id, 'mode'     ,mode)

       dim3_id(1) = numland_dim; dim3_id(2) = maxpatch_dim; dim3_id(3) = nlevsoi_dim
       name = 'lake temperature'
       unit = 'K'
       call wrap_def_var (ncid, 'T_LAKE_INI', nf_double, 3, dim3_id, t_lake_id)
       call wrap_put_att_text (ncid, t_lake_id, 'long_name',name)
       call wrap_put_att_text (ncid, t_lake_id, 'units'    ,unit)
       call wrap_put_att_text (ncid, t_lake_id, 'mode'     ,mode)

       dim3_id(1) = numland_dim; dim3_id(2) = maxpatch_dim; dim3_id(3) = nlevtot_dim
       name = 'liquid water'
       unit = 'kg/m2'
       call wrap_def_var (ncid, 'H2OSOI_LIQ_INI', nf_double, 3, dim3_id, h2osoi_liq_id)
       call wrap_put_att_text (ncid, h2osoi_liq_id, 'long_name',name)
       call wrap_put_att_text (ncid, h2osoi_liq_id, 'units'    ,unit)
       call wrap_put_att_text (ncid, h2osoi_liq_id, 'mode'     ,mode)

       dim3_id(1) = numland_dim; dim3_id(2) = maxpatch_dim; dim3_id(3) = nlevtot_dim
       name = 'ice lens'
       unit = 'kg/m2'                                                       
       call wrap_def_var (ncid, 'H2OSOI_ICE_INI', nf_double, 3, dim3_id, h2osoi_ice_id)
       call wrap_put_att_text (ncid, h2osoi_ice_id, 'long_name',name)
       call wrap_put_att_text (ncid, h2osoi_ice_id, 'units'    ,unit)
       call wrap_put_att_text (ncid, h2osoi_ice_id, 'mode'     ,mode)

       dim3_id(1) = numland_dim; dim3_id(2) = maxpatch_dim; dim3_id(3) = nlevsno_dim
       name = 'snow layer depth'
       unit = 'm'
       call wrap_def_var (ncid, 'ZSNO_INI', nf_double, 3, dim3_id, zsno_id)
       call wrap_put_att_text (ncid, zsno_id, 'long_name',name)
       call wrap_put_att_text (ncid, zsno_id, 'units'    ,unit)
       call wrap_put_att_text (ncid, zsno_id, 'mode'     ,mode)

       dim3_id(1) = numland_dim; dim3_id(2) = maxpatch_dim; dim3_id(3) = nlevsno_dim
       name = 'snow layer thickness'
       unit = 'm'
       call wrap_def_var (ncid, 'DZSNO_INI', nf_double, 3, dim3_id, dzsno_id)
       call wrap_put_att_text (ncid, dzsno_id, 'long_name',name)
       call wrap_put_att_text (ncid, dzsno_id, 'units'    ,unit)
       call wrap_put_att_text (ncid, dzsno_id, 'mode'     ,mode)

       dim3_id(1) = numland_dim; dim3_id(2) = maxpatch_dim; dim3_id(3) = nlevsno_dim
       name = 'snow interface depth'
       unit = 'm'
       call wrap_def_var (ncid, 'ZISNO_INI', nf_double, 3, dim3_id, zisno_id)
       call wrap_put_att_text (ncid, zisno_id, 'long_name',name)
       call wrap_put_att_text (ncid, zisno_id, 'units'    ,unit)
       call wrap_put_att_text (ncid, zisno_id, 'mode'     ,mode)

#if (defined RTM)
       dim2_id(1) = rtmlon_dim ; dim2_id(2) = rtmlat_dim

       name = 'water volumn in cell (volr)'
       unit = 'm3'
       call wrap_def_var (ncid, 'RTMVOLR', nf_double, 2, dim2_id, volr_id)
       call wrap_put_att_text (ncid, volr_id, 'long_name',name)
       call wrap_put_att_text (ncid, volr_id, 'units'    ,unit)
       call wrap_put_att_text (ncid, volr_id, 'mode'     ,mode)
#endif

! finish creating netCDF file (end define mode)

       status = nf_enddef(ncid)

    endif  !end of if-masterproc block

! --------------------------------------------------------------------
! Write single-level variables: [numland x maxpatch] and 
! multi-level variables: [numland x maxpatch x lev]
! NOTE: for non-spmd begpatch=1 and endpatch=numpatch
! --------------------------------------------------------------------

! Convert clm derived type components to patch vectors
! Convert initial data from subgrid patch form to land point form

    allocate (ibuf1dl(numland,maxpatch))
    allocate (rbuf1dl(numland,maxpatch))
    allocate (ibuf1dp(begpatch:endpatch))
    allocate (rbuf1dp(begpatch:endpatch))

    ! Write out zisno
    allocate (rbuf2dp(-nlevsno+0:-1,begpatch:endpatch))
    allocate (rbuf2dl(numland,maxpatch,-nlevsno+0:-1)) 
    do k = begpatch,endpatch
       rbuf2dp(-nlevsno+0:-1,k) = clm(k)%zi(-nlevsno+0:-1)  
    end do
    call patch_to_land (rbuf2dp, rbuf2dl, nlevsno)
    if (masterproc) call wrap_put_var_realx (ncid, zisno_id, rbuf2dl)
    deallocate (rbuf2dl)
    deallocate (rbuf2dp)

    ! Write out zsno
    allocate (rbuf2dl(numland,maxpatch,-nlevsno+1:0))
    allocate (rbuf2dp(-nlevsno+1: 0,begpatch:endpatch))
    do k = begpatch,endpatch
       rbuf2dp(-nlevsno+1:0,k) = clm(k)%z(-nlevsno+1:0)  
    end do
    call patch_to_land (rbuf2dp, rbuf2dl, nlevsno)
    if (masterproc) call wrap_put_var_realx (ncid, zsno_id, rbuf2dl)
    deallocate (rbuf2dl)
    deallocate (rbuf2dp)

    ! Write out dzsno
    allocate (rbuf2dl(numland,maxpatch,-nlevsno+1:0))
    allocate (rbuf2dp(-nlevsno+1: 0,begpatch:endpatch))
    do k = begpatch,endpatch
       rbuf2dp(-nlevsno+1: 0,k) = clm(k)%dz(-nlevsno+1: 0)  
    end do
    call patch_to_land (rbuf2dp, rbuf2dl, nlevsno)
    if (masterproc) call wrap_put_var_realx (ncid, dzsno_id, rbuf2dl)
    deallocate (rbuf2dl)
    deallocate (rbuf2dp)

    ! Write out h2osoi_liq
    allocate (rbuf2dl(numland,maxpatch,-nlevsno+1:nlevsoi)) 
    allocate (rbuf2dp(-nlevsno+1:nlevsoi,begpatch:endpatch))
    do k = begpatch,endpatch
       rbuf2dp(-nlevsno+1:nlevsoi,k) = clm(k)%h2osoi_liq(-nlevsno+1:nlevsoi) 
    end do
    call patch_to_land (rbuf2dp, rbuf2dl, nlevsno+nlevsoi)
    if (masterproc) call wrap_put_var_realx (ncid, h2osoi_liq_id, rbuf2dl)
    deallocate (rbuf2dl)
    deallocate (rbuf2dp)

    ! Write out h2osoi_ice
    allocate (rbuf2dl(numland,maxpatch,-nlevsno+1:nlevsoi)) 
    allocate (rbuf2dp(-nlevsno+1:nlevsoi,begpatch:endpatch))
    do k = begpatch,endpatch
       rbuf2dp(-nlevsno+1:nlevsoi,k) = clm(k)%h2osoi_ice(-nlevsno+1:nlevsoi) 
    end do
    call patch_to_land (rbuf2dp, rbuf2dl, nlevsno+nlevsoi)
    if (masterproc) call wrap_put_var_realx (ncid, h2osoi_ice_id, rbuf2dl)
    deallocate (rbuf2dl)
    deallocate (rbuf2dp)

    ! Write out t_soisno
    allocate (rbuf2dl(numland,maxpatch,-nlevsno+1:nlevsoi)) 
    allocate (rbuf2dp(-nlevsno+1:nlevsoi,begpatch:endpatch))
    do k = begpatch,endpatch
       rbuf2dp(-nlevsno+1:nlevsoi,k) = clm(k)%t_soisno(-nlevsno+1:nlevsoi) 
    end do
    call patch_to_land (rbuf2dp, rbuf2dl, nlevsno+nlevsoi)
    if (masterproc) call wrap_put_var_realx (ncid, t_soisno_id, rbuf2dl)
    deallocate (rbuf2dl)
    deallocate (rbuf2dp)

    ! Write out t_lake
    allocate(rbuf2dl(numland,maxpatch,1:nlevlak))
    allocate(rbuf2dp(1:nlevlak,begpatch:endpatch))
    do k = begpatch,endpatch
       rbuf2dp(1:nlevlak,k) = clm(k)%t_lake(1:nlevlak)
    end do
    call patch_to_land (rbuf2dp, rbuf2dl, nlevlak)
    if (masterproc) call wrap_put_var_realx (ncid, t_lake_id, rbuf2dl)
    deallocate (rbuf2dl)
    deallocate (rbuf2dp)

    ! Write out t_veg
    do k = begpatch,endpatch
       rbuf1dp(k) = clm(k)%t_veg   
    end do
    call patch_to_land (rbuf1dp, rbuf1dl)
    if (masterproc) call wrap_put_var_realx (ncid, t_veg_id, rbuf1dl)

    ! Write out t_grnd
    do k = begpatch,endpatch
       rbuf1dp(k) = clm(k)%t_grnd  
    end do
    call patch_to_land (rbuf1dp, rbuf1dl)
    if (masterproc) call wrap_put_var_realx (ncid, t_grnd_id, rbuf1dl)

    ! Write out h2ocan
    do k = begpatch,endpatch
       rbuf1dp(k) = clm(k)%h2ocan  
    end do
    call patch_to_land (rbuf1dp, rbuf1dl)
    if (masterproc) call wrap_put_var_realx (ncid, h2ocan_id, rbuf1dl)

    ! Write out h2osno
    do k = begpatch,endpatch
       rbuf1dp(k) = clm(k)%h2osno  
    end do
    call patch_to_land (rbuf1dp, rbuf1dl)
    if (masterproc) call wrap_put_var_realx (ncid, h2osno_id, rbuf1dl)

    ! Write out snowdp
    do k = begpatch,endpatch
       rbuf1dp(k) = clm(k)%snowdp
    end do
    call patch_to_land (rbuf1dp, rbuf1dl)
    if (masterproc) call wrap_put_var_realx (ncid, snowdp_id, rbuf1dl)

    ! Write out snowage
    do k = begpatch,endpatch
       rbuf1dp(k)= clm(k)%snowage
    end do
    call patch_to_land (rbuf1dp, rbuf1dl)
    if (masterproc) call wrap_put_var_realx (ncid, snowage_id, rbuf1dl)