histfilemod.f90

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

       unit = 'degrees_east'
       call wrap_def_var (ncid(nf), 'edgew', ncprec, 0, 0, edgew_id(nf))
       call wrap_put_att_text (ncid(nf), edgew_id(nf) , 'long_name',name)
       call wrap_put_att_text (ncid(nf), edgew_id(nf) , 'units'    ,unit)
       call wrap_put_att_text (ncid(nf), edgew_id(nf) , 'mode'     ,mode)
    endif
       
#endif

! longitude, latitude, surface type: real (lsmlon x lsmlat)

    dim2_id(1) = lon_id
    dim2_id(2) = lat_id

    if (fullgrid) then
       name = 'longitude'
       unit = 'degrees_east'
       call wrap_def_var (ncid(nf), 'longxy' , ncprec, 2, dim2_id, longxy_id(nf))
    else
       name = 'rlongitude'
       unit = 'degrees_east'
       call wrap_def_var (ncid(nf), 'rlongxy', ncprec, 2, dim2_id, longxy_id(nf))
    endif
    call wrap_put_att_text (ncid(nf), longxy_id(nf), 'long_name',name)
    call wrap_put_att_text (ncid(nf), longxy_id(nf), 'units'    ,unit)
    call wrap_put_att_text (ncid(nf), longxy_id(nf), 'mode'     ,mode)

    name = 'latitude'
    unit = 'degrees_north'
    call wrap_def_var (ncid(nf), 'latixy', ncprec, 2, dim2_id, latixy_id(nf))
    call wrap_put_att_text (ncid(nf), latixy_id(nf), 'long_name',name)
    call wrap_put_att_text (ncid(nf), latixy_id(nf), 'units'    ,unit)
    call wrap_put_att_text (ncid(nf), latixy_id(nf), 'mode'     ,mode)

    name = 'grid cell areas'
    unit = 'km^2'
    call wrap_def_var (ncid(nf), 'area', ncprec, 2, dim2_id, area_id(nf))
    call wrap_put_att_text (ncid(nf), area_id(nf), 'long_name',name)
    call wrap_put_att_text (ncid(nf), area_id(nf), 'units'    ,unit)
    call wrap_put_att_text (ncid(nf), area_id(nf), 'mode'     ,mode)

    name = 'land fraction'
    call wrap_def_var (ncid(nf), 'landfrac', ncprec, 2, dim2_id, landfrac_id(nf))
    call wrap_put_att_text (ncid(nf), landfrac_id(nf), 'long_name',name)
    call wrap_put_att_text (ncid(nf), landfrac_id(nf), 'mode'     ,mode)

! number of longitudes per latitude (reduced grid only)

    dim1_id(1) = lat_id
    name = 'number of longitudes at each latitude'
    call wrap_def_var (ncid(nf), 'numlon', nf_int, 1, dim1_id, numlon_id(nf))
    call wrap_put_att_text (ncid(nf), numlon_id(nf), 'long_name', name)

! Surface type

    name = 'land/ocean mask (0.=ocean and 1.=land)'
    call wrap_def_var (ncid(nf), 'landmask', nf_int, 2, dim2_id, landmask_id(nf))
    call wrap_put_att_text (ncid(nf),landmask_id(nf),'long_name',name)
    call wrap_put_att_text (ncid(nf),landmask_id(nf),'mode'     ,mode)

! --------------------------------------------------------------------
! Define time-dependent variables: time information
! --------------------------------------------------------------------

    mode = trim(ninst)

! current date, day and time step

    dim1_id(1) = tim_id

    name = 'current date (YYYYMMDD)'
    call wrap_def_var (ncid(nf) , 'mcdate', nf_int, 1, dim1_id  , mcdate_id(nf))
    call wrap_put_att_text (ncid(nf), mcdate_id(nf), 'long_name',name)
    call wrap_put_att_text (ncid(nf), mcdate_id(nf), 'mode'     ,mode)

    name = 'current seconds of current date'
    unit = 's'
    call wrap_def_var (ncid(nf) , 'mcsec' , nf_int, 1, dim1_id , mcsec_id(nf))
    call wrap_put_att_text (ncid(nf), mcsec_id(nf), 'long_name',name)
    call wrap_put_att_text (ncid(nf), mcsec_id(nf), 'units'    ,unit)
    call wrap_put_att_text (ncid(nf), mcsec_id(nf), 'mode'     ,mode)

    name = 'current day (from base day)'
    call wrap_def_var (ncid(nf) , 'mdcur' , nf_int, 1, dim1_id , mdcur_id(nf))
    call wrap_put_att_text (ncid(nf), mdcur_id(nf), 'long_name',name)
    call wrap_put_att_text (ncid(nf), mdcur_id(nf), 'mode'     ,mode)

    name = 'current seconds of current day'
    call wrap_def_var (ncid(nf) , 'mscur' , nf_int, 1, dim1_id , mscur_id(nf))
    call wrap_put_att_text (ncid(nf), mscur_id(nf), 'long_name',name)
    call wrap_put_att_text (ncid(nf), mscur_id(nf), 'mode'     ,mode)

    name = 'time step'
    call wrap_def_var (ncid(nf) , 'nstep' , nf_int, 1, dim1_id , nstep_id(nf))
    call wrap_put_att_text (ncid(nf), nstep_id(nf), 'long_name',name)
    call wrap_put_att_text (ncid(nf), nstep_id(nf), 'mode'     ,mode)

! character time comment: character (80 x time)

    dim2_id(1) = strlen_id
    dim2_id(2) = tim_id

    name = 'history interval for time slice'
    call wrap_def_var (ncid(nf) , 'time_comment', nf_char, 2, dim2_id, timcom_id(nf))
    call wrap_put_att_text (ncid(nf), timcom_id(nf), 'long_name',name)
    call wrap_put_att_text (ncid(nf), timcom_id(nf), 'mode'     ,mode)

! --------------------------------------------------------------------
! Define time-dependent variables: active history file fields.
! Array dimensions depend on whether it is
!
! single-level
! o 1-d vector   (hist_dov2xy = false): numpatch x time
! o grid average (hist_dov2xy = true ): lsmlon x lsmlat x time
! 
! multi-level soil (static levels)
! o 1-d vector   (hist_dov2xy = false): numpatch x nlevsoi x time
! o grid average (hist_dov2xy = true ): lsmlon x lsmlat x nlevsoi x time
! --------------------------------------------------------------------

! single level fields

    do i = 1, slfld%num(nf)
       if (hist_dov2xy(nf)) then
          dim3_id(1) = lon_id         
          dim3_id(2) = lat_id         
          dim3_id(3) = tim_id         
          call wrap_def_var (ncid(nf), slfld%nam(i,nf),  ncprec, 3, dim3_id, slfld_id(i,nf))
       else                                                                
          dim2_id(1) = patch_id                                            
          dim2_id(2) = tim_id                                              
          call wrap_def_var (ncid(nf), slfld%nam(i,nf),  ncprec, 2, dim2_id, slfld_id(i,nf))
       end if
    end do

! multi-level soil fields 

    do i = 1, mlsoifld%num(nf)
       if (hist_dov2xy(nf)) then
          dim4_id(1) = lon_id      
          dim4_id(2) = lat_id   
          dim4_id(3) = levsoi_id   
          dim4_id(4) = tim_id      
          call wrap_def_var (ncid(nf), mlsoifld%nam(i,nf), ncprec, 4, dim4_id, mlsoifld_id(i,nf))
       else                                                               
          dim3_id(1) = patch_id                                           
          dim3_id(2) = levsoi_id                                             
          dim3_id(3) = tim_id                                             
          call wrap_def_var (ncid(nf), mlsoifld%nam(i,nf), ncprec, 3, dim3_id, mlsoifld_id(i,nf))
       endif
    end do

! define attributes for each field: long name, units, 
! mode (inst, aver, etc), and fill value (spval)

    do i = 1, slfld%num(nf)
       call wrap_put_att_text (ncid(nf), slfld_id(i,nf), 'long_name' , slfld%des(i,nf))
       call wrap_put_att_text (ncid(nf), slfld_id(i,nf), 'units'     , slfld%uni(i,nf))
       call wrap_put_att_text (ncid(nf), slfld_id(i,nf), 'mode'      , slfld%typ(i,nf))
       call wrap_put_att_realx(ncid(nf), slfld_id(i,nf), '_FillValue', ncprec,1 ,spval)
       call wrap_put_att_realx(ncid(nf), slfld_id(i,nf), 'missing_value', ncprec,1 ,spval)
    end do

    do i = 1, mlsoifld%num(nf)
       call wrap_put_att_text (ncid(nf), mlsoifld_id(i,nf), 'long_name' , mlsoifld%des(i,nf))
       call wrap_put_att_text (ncid(nf), mlsoifld_id(i,nf), 'units'     , mlsoifld%uni(i,nf))
       call wrap_put_att_text (ncid(nf), mlsoifld_id(i,nf), 'mode'      , mlsoifld%typ(i,nf))
       call wrap_put_att_realx(ncid(nf), mlsoifld_id(i,nf), '_FillValue', ncprec,1 ,spval)
       call wrap_put_att_realx(ncid(nf), mlsoifld_id(i,nf), 'missing_value', ncprec,1 ,spval)
    end do

! --------------------------------------------------------------------
! Finish creating netCDF file (end define mode)
! --------------------------------------------------------------------

    status = nf_enddef(ncid(nf))

    return
  end subroutine histcrt

!=======================================================================

  subroutine histwrt (nf)

!----------------------------------------------------------------------- 
! 
! Purpose: 
! write to netCDF history file
!
! Method: 
! 
! Author: Mariana Vertenstein
! 
!-----------------------------------------------------------------------

    use precision	
    use clm_varder
    use clm_varsur        !surface data   
    use clm_varctl        !run control variables 
#if (defined SPMD)
    use spmdMod     , only : masterproc, npes, compute_mpigs_patch
    use mpishorthand, only : mpir8, mpilog, mpiint, mpicom 
#else
    use spmdMod     , only : masterproc
#endif
    use time_manager, only : get_nstep, get_curr_date, get_curr_time
    implicit none

! ------------------------ includes ----------------------------------
    include 'netcdf.inc'
! --------------------------------------------------------------------

! ------------------------ arguments ---------------------------------
    integer, intent(in) :: nf   !current history file: 
                                !1 = primary  2,3 = auxillary
! --------------------------------------------------------------------

! ------------------------ local variables ---------------------------
    integer  :: i,j,k,l,m,n                    !do loop indices
    integer  :: beg1d(1)                       !netCDF 1-d start index 
    integer  :: len1d(1)                       !netCDF 1-d count index 
    integer  :: beg2d(2)                       !netCDF 2-d start index 
    integer  :: len2d(2)                       !netCDF 2-d count index 
    integer  :: beg3d(3)                       !netCDF 3-d start index 
    integer  :: len3d(3)                       !netCDF 3-d count index 
    integer  :: beg4d(4)                       !netCDF 4-d start index 
    integer  :: len4d(4)                       !netCDF 4-d count index 
    real(r8) :: slfxy(lsmlon,lsmlat)           !grid-average single-level field
    real(r8) :: mlsoifxy(lsmlon,lsmlat,nlevsoi)!grid-average multi-level soil field
    real(r8) :: lonvar(lsmlon)                 !only used for full grid 
    real(r8) :: latvar(lsmlat)                 !only used for full grid
    real(r8) :: time                           !current time
    integer  :: mdcur, mscur                   !outputs from get_curr_time
    integer  :: yr,mon,day,mcsec               !outputs from get_curr_date
    integer  :: mcdate                         !current date 
    integer  :: nstep                          !time step
#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 error status
    real(r8), allocatable :: buf1d(:)          !temporary for MPI gatherv
    real(r8), allocatable :: gather1d(:)       !temporary for MPI gatherv
    real(r8), allocatable :: buf2d(:,:)        !temporary for MPI gatherv
    real(r8), allocatable :: gather2d(:,:)     !temporary for MPI gatherv
#endif
! --------------------------------------------------------------------

! --------------------------------------------------------------------
! Write out time-invariant variables. Do once, at first write to file.
! --------------------------------------------------------------------

    if (ntim(nf) == 1) then

#if (defined OFFLINE)
       if (masterproc) then
          if (.not. offline_rdgrid) then
             call wrap_put_var_realx (ncid(nf), edgen_id(nf), lsmedge(1))
             call wrap_put_var_realx (ncid(nf), edgee_id(nf), lsmedge(2))
             call wrap_put_var_realx (ncid(nf), edges_id(nf), lsmedge(3))
             call wrap_put_var_realx (ncid(nf), edgew_id(nf), lsmedge(4))
          endif
       endif
#endif

! Surface grid (coordinate variables, latitude, longitude, surface type). 

       if (masterproc) then
          if (fullgrid) then
             lonvar(1:lsmlon) = longxy(1:lsmlon,1)
             call wrap_put_var_realx (ncid(nf), lonvar_id(nf), lonvar)
             latvar(1:lsmlat) = latixy(1,1:lsmlat)
             call wrap_put_var_realx (ncid(nf), latvar_id(nf), latvar)
          endif
          call wrap_put_var_realx (ncid(nf), levvar_id(nf)  , zsoi)
          call wrap_put_var_realx (ncid(nf), longxy_id(nf)  , longxy)
          call wrap_put_var_realx (ncid(nf), latixy_id(nf)  , latixy)
          call wrap_put_var_realx (ncid(nf), area_id(nf)    , area) 
          call wrap_put_var_realx (ncid(nf), landfrac_id(nf), landfrac) 
          call wrap_put_var_int   (ncid(nf), landmask_id(nf), landmask)
          call wrap_put_var_int   (ncid(nf), numlon_id(nf)  , numlon)
       endif

    end if !end of write of time constant variables

! --------------------------------------------------------------------
! Get variable id's for time-varying variables if restart and
! current history file is not full. Needs to be done so that 
! non-full history files can be filled before a new file is created
! --------------------------------------------------------------------

    if (masterproc) then
       if (ncgetid(nf)) then
          call wrap_inq_varid (ncid(nf), 'mcdate', mcdate_id(nf))
          call wrap_inq_varid (ncid(nf), 'mcsec' , mcsec_id(nf))
          call wrap_inq_varid (ncid(nf), 'mdcur' , mdcur_id(nf))
          call wrap_inq_varid (ncid(nf), 'mscur' , mscur_id(nf))
          call wrap_inq_varid (ncid(nf), 'nstep' , nstep_id(nf))
          call wrap_inq_varid (ncid(nf), 'time'  , timvar_id(nf))
          call wrap_inq_varid (ncid(nf), 'time_comment', timcom_id(nf))
          do i = 1, slfld%num(nf)
             call wrap_inq_varid (ncid(nf), slfld%nam(i,nf), slfld_id(i,nf))
          end do
          do i = 1, mlsoifld%num(nf)
             call wrap_inq_varid (ncid(nf), mlsoifld%nam(i,nf), mlsoifld_id(i,nf))
          end do
          ncgetid(nf) = .false.
       end if
    endif

! --------------------------------------------------------------------
! Write time-varying variables
! --------------------------------------------------------------------

! current date, seconds, day and nstep

    if (masterproc) then
       beg1d(1) = ntim(nf) ; len1d(1) = 1
       call get_curr_date(yr, mon, day, mcsec)
       mcdate = yr*10000 + mon*100 + day
       call get_curr_time(mdcur,mscur)  
       time = mdcur + mscur/SHR_CONST_CDAY
       nstep = get_nstep()
       call wrap_put_vara_int (ncid(nf), mcdate_id(nf), beg1d, len1d, mcdate)
       call wrap_put_vara_int (ncid(nf), mcsec_id(nf) , beg1d, len1d, mcsec)
       call wrap_put_vara_int (ncid(nf), mdcur_id(nf) , beg1d, len1d, mdcur)
       call wrap_put_vara_int (ncid(nf), mscur_id(nf) , beg1d, len1d, mscur)
       call wrap_put_vara_int (ncid(nf), nstep_id(nf) , beg1d, len1d, nstep)
       call wrap_put_vara_realx (ncid(nf), timvar_id(nf), beg1d, len1d, time)