histfilemod.f90

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

                n = slfld%num(k)
                slfld%nam(n,k) = slfld%nam(i,1)
                slfld%uni(n,k) = slfld%uni(i,1)
                slfld%typ(n,k) = slfld%typ(i,1)
                slfld%des(n,k) = slfld%des(i,1)
             end if
          end do
          do i = 1, mlsoifld%num(1)
             if (fldaux(j,k-1) == mlsoifld%nam(i,1)) then
                mlsoifld%num(k) = mlsoifld%num(k) + 1
                n = mlsoifld%num(k)
                mlsoifld%nam(n,k) = mlsoifld%nam(i,1)
                mlsoifld%uni(n,k) = mlsoifld%uni(i,1)
                mlsoifld%typ(n,k) = mlsoifld%typ(i,1)
                mlsoifld%des(n,k) = mlsoifld%des(i,1)
             end if
          end do
       end do
       if (slfld%num(k) > max_slevflds) then
          write(6,*) 'HISTLST error: number single-level fields', &
               ' for auxillary files > parameter max_slevflds '
          call endrun
       endif
       if (mlsoifld%num(k) > max_mlevflds) then
          write(6,*) 'HISTLST error: number multi-level fields', &
               ' for auxillary files > parameter max_mlevflds '
          call endrun
       endif
    end do

    j = 0
    do i = 1, nhist
       if ((slfld%num(i)+mlsoifld%num(i)) > 0) j = j + 1
    end do
    if (j /= nhist) then
       write(6,*) 'HISTLST error: number of history files = ', nhist
       write(6,*) 'but number of files based on active fields = ',j
       call endrun
    end if

! echo active fields 

    if (masterproc) then
       do j = 1, nhist
          if (slfld%num(j) > 0) then
             write(6,*)
             write(6,*) 'History file ',j,': Active single-level fields'
             write(6,1002) 
             write(6,'(72a1)') ("_",i=1,71)
             do i = 1, slfld%num(j)
                write(6,1003)i,slfld%nam(i,j),&
                     slfld%uni(i,j),slfld%typ(i,j),slfld%des(i,j)
             end do
             write(6,'(72a1)') ("_",i=1,71)
             write(6,*)
          end if
          if (mlsoifld%num(j) > 0) then
             write(6,*) 'History file ',j,': Active multi-level soil fields'
             write(6,1002) 
             write(6,'(72a1)') ("_",i=1,71)
             do i = 1, mlsoifld%num(j)
                write(6,1003)i,mlsoifld%nam(i,j),&
                     mlsoifld%uni(i,j),mlsoifld%typ(i,j),mlsoifld%des(i,j)
             end do
             write(6,'(72a1)') ("_",i=1,71)
             write(6,*)
          end if
       end do
    endif
1002 format(' No',' Name    ',' Units   ',' Type    ',' Description')
1003 format((1x,i2),(1x,a8),(1x,a8),(1x,a8),(1x,a40))

    return
  end subroutine histlst

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

  subroutine histfldini (nflds, name, unit, levl, type, &
                         desc, active, histfld)

!----------------------------------------------------------------------- 
! 
! Purpose: 
! Set up history file field (active or inactive)
!
! Method: 
! 
! Author: Gordon Bonan
! 
!-----------------------------------------------------------------------

! ------------------------ arguments ---------------------------------
    integer, intent(inout)       :: nflds   !number of fields       
    character(len=*), intent(in) :: name    !field name
    character(len=*), intent(in) :: unit    !field units 
    character(len=*), intent(in) :: levl    !field level type 
    character(len=*), intent(in) :: type    !field time averaging type
    character(len=*), intent(in) :: desc    !field description
    logical         , intent(in) :: active  !true=> field is active
    type(histentry) , intent(out):: histfld !history field entry
! --------------------------------------------------------------------

    nflds = nflds + 1
    histfld%name(nflds)   = name
    histfld%unit(nflds)   = unit
    histfld%levl(nflds)   = levl
    histfld%type(nflds)   = type
    histfld%desc(nflds)   = desc
    histfld%active(nflds) = active

    return
  end subroutine histfldini

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

  subroutine histcrt (nf)

!----------------------------------------------------------------------- 
! 
! Purpose: 
! create netCDF history file
!
! Method: 
! This subroutine opens a new netCDF data file. Global attributes
! and variables are defined in define mode. Upon exiting this
! routine, define mode is exited and the file is ready to write.
!
! Author: Mariana Vertenstein
! 
!-----------------------------------------------------------------------

    use clm_varsur  , only : fullgrid, offline_rdgrid 	
    use time_manager, only : get_ref_date 
    use clm_varctl        
    include 'netcdf.inc'

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

! ------------------------ local variables ---------------------------
    integer i           !field do loop index
    integer status      !netCDF error status
    integer tim_id      !netCDF id for time dimension
    integer lon_id      !netCDF id for longitude dimension
    integer lat_id      !netCDF id for latitude dimension
    integer levsoi_id   !netCDF id for soil layer dimension
    integer patch_id    !netCDF id for total number subgrid patches
    integer strlen_id   !netCDF id for character string variables
    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 dim4_id(4)  !netCDF dimension id for 4-d variables
    integer omode       !netCDF dummy variable
    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=256) str      !global attribute string 
    character(len=  8) curdate  !current date
    character(len=  8) curtime  !current time 
    character(len= 10) basedate !base date (yyyymmdd)
    character(len=  8) basesec  !base seconds
    integer yr,mon,day,nbsec    !year,month,day,seconds components of a date
    integer hours,minutes,secs  !hours,minutes,seconds of hh:mm:ss
! --------------------------------------------------------------------

! --------------------------------------------------------------------
! Create new netCDF file. File will be in define mode
! --------------------------------------------------------------------

    call wrap_create (trim(locfnh(nf)), nf_clobber, ncid(nf))

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

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

! --------------------------------------------------------------------
! Create global attributes. Attributes are used to store information
! about the data set. Global attributes are information about the
! data set as a whole, as opposed to a single variable
! --------------------------------------------------------------------

    str = 'CF1.0'
    call wrap_put_att_text (ncid(nf), NF_GLOBAL, 'conventions', trim(str))
    
    call datetime(curdate, curtime)
    str = 'created on ' // curdate // ' ' // curtime
    call wrap_put_att_text(ncid(nf), NF_GLOBAL,'history', trim(str))

    call getenv ('LOGNAME', str)
    call wrap_put_att_text (ncid(nf), NF_GLOBAL, 'logname',trim(str))
    
    call getenv ('HOST', str)
    call wrap_put_att_text (ncid(nf), NF_GLOBAL, 'host', trim(str))
    
    str = 'Community Land Model: CLM2'
    call wrap_put_att_text (ncid(nf), NF_GLOBAL, 'source', trim(str))
    
    str = '$Name: cam2_0_brnchT_release3 $'
    call wrap_put_att_text (ncid(nf), NF_GLOBAL, 'version', trim(str))
    
    str = '$Id: histFileMod.F90,v 1.19.6.6.6.1 2002/05/13 19:25:04 erik Exp $'
    call wrap_put_att_text (ncid(nf), NF_GLOBAL, 'revision_id', trim(str))
    
    str = ctitle 
    call wrap_put_att_text (ncid(nf), NF_GLOBAL, 'case_title', trim(str))

    str = caseid
    call wrap_put_att_text (ncid(nf), NF_GLOBAL, 'case_id', trim(str))
    
    if (fsurdat == ' ') then
       str = 'created at run time'
    else
       str = get_filename(fsurdat)
    endif
    call wrap_put_att_text(ncid(nf), NF_GLOBAL, 'Surface_dataset', trim(str))

    if (finidat == ' ') then
       str = 'arbitrary initialization'
    else
       str = get_filename(finidat)
    endif
    call wrap_put_att_text(ncid(nf), NF_GLOBAL, 'Initial_conditions_dataset', trim(str))

    str = get_filename(fpftcon)
    call wrap_put_att_text(ncid(nf), NF_GLOBAL, 'PFT_physiological_constants_dataset', trim(str))

    if (frivinp_rtm /= ' ') then
       str = get_filename(frivinp_rtm)
       call wrap_put_att_text(ncid(nf), NF_GLOBAL, 'RTM_input_datset', trim(str))
    endif

! --------------------------------------------------------------------
! Define dimensions. Array dimensions are referenced by an
! associated dimenision id: e.g., lon_id -> lon.
! o Time is an unlimited dimension.
! o Character string is treated as an array of characters. 
! --------------------------------------------------------------------

    call wrap_def_dim (ncid(nf), 'lon'   , lsmlon , lon_id)
    call wrap_def_dim (ncid(nf), 'lat'   , lsmlat , lat_id)
    call wrap_def_dim (ncid(nf), 'levsoi', nlevsoi, levsoi_id)
    if (.not. hist_dov2xy(nf)) then
       call wrap_def_dim (ncid(nf), 'patch', numpatch, patch_id)
    end if
    call wrap_def_dim (ncid(nf), 'time'  , nf_unlimited, tim_id)
    call wrap_def_dim (ncid(nf), 'string_length', 80, strlen_id)

! --------------------------------------------------------------------
! Define time-independent grid variables 
! --------------------------------------------------------------------

    mode = 'time-invariant'

! coordinate variables (including time)

    if (fullgrid) then
       dim1_id(1) = lon_id
       name = 'coordinate longitude'
       unit = 'degrees_east'
       call wrap_def_var (ncid(nf), 'lon' , ncprec, 1, dim1_id, lonvar_id(nf))
       call wrap_put_att_text (ncid(nf), lonvar_id(nf), 'long_name',name)
       call wrap_put_att_text (ncid(nf), lonvar_id(nf), 'units'    ,unit)
       call wrap_put_att_text (ncid(nf), lonvar_id(nf), 'mode'     ,mode)
       
       dim1_id(1) = lat_id
       name = 'coordinate latitude'
       unit = 'degrees_north'
       call wrap_def_var (ncid(nf), 'lat' , ncprec, 1, dim1_id, latvar_id(nf))
       call wrap_put_att_text (ncid(nf), latvar_id(nf), 'long_name',name)
       call wrap_put_att_text (ncid(nf), latvar_id(nf), 'units'    ,unit)
       call wrap_put_att_text (ncid(nf), latvar_id(nf), 'mode'     ,mode)
    endif

    dim1_id(1) = levsoi_id
    name = 'coordinate soil levels'
    unit = 'm'
    call wrap_def_var (ncid(nf), 'levsoi' , ncprec, 1, dim1_id, levvar_id(nf))
    call wrap_put_att_text (ncid(nf), levvar_id(nf), 'long_name',name)
    call wrap_put_att_text (ncid(nf), levvar_id(nf), 'units'    ,unit)
    call wrap_put_att_text (ncid(nf), levvar_id(nf), 'mode'     ,mode)

    dim1_id(1) = tim_id
    name = 'time'
    call get_ref_date(yr, mon, day, nbsec)
    hours   = nbsec / 3600
    minutes = (nbsec - hours*3600) / 60
    secs    = (nbsec - hours*3600 - minutes*60)
    write(basedate,80) yr,mon,day
80  format(i4.4,'-',i2.2,'-',i2.2)
    write(basesec ,90) hours, minutes, secs
90  format(i2.2,':',i2.2,':',i2.2)
    unit = 'days since ' // basedate // " " // basesec
    call wrap_def_var (ncid(nf), 'time', ncprec, 1, dim1_id, timvar_id(nf))
    call wrap_put_att_text (ncid(nf), timvar_id(nf), 'long_name',name)
    call wrap_put_att_text (ncid(nf), timvar_id(nf), 'units'    ,unit)
    call wrap_put_att_text (ncid(nf), timvar_id(nf), 'calendar' ,'noleap')

#if (defined OFFLINE)

! surface grid edges

    if (.not. offline_rdgrid) then
       name = 'northern edge of surface grid'
       unit = 'degrees_north'
       call wrap_def_var (ncid(nf) , 'edgen', ncprec, 0, 0, edgen_id(nf))
       call wrap_put_att_text (ncid(nf), edgen_id(nf), 'long_name',name)
       call wrap_put_att_text (ncid(nf), edgen_id(nf), 'units'    ,unit)
       call wrap_put_att_text (ncid(nf), edgen_id(nf), 'mode'     ,mode)
       
       name = 'eastern edge of surface grid'
       unit = 'degrees_east'
       call wrap_def_var (ncid(nf), 'edgee', ncprec,0, 0, edgee_id(nf))
       call wrap_put_att_text (ncid(nf), edgee_id(nf), 'long_name',name)
       call wrap_put_att_text (ncid(nf), edgee_id(nf), 'units'    ,unit)
       call wrap_put_att_text (ncid(nf), edgee_id(nf), 'mode'     ,mode)
       
       name = 'southern edge of surface grid'
       unit = 'degrees_north'
       call wrap_def_var (ncid(nf), 'edges', ncprec, 0, 0, edges_id(nf))
       call wrap_put_att_text (ncid(nf), edges_id(nf), 'long_name',name)
       call wrap_put_att_text (ncid(nf), edges_id(nf), 'units'    ,unit)
       call wrap_put_att_text (ncid(nf), edges_id(nf), 'mode'     ,mode)
       
       name = 'western edge of surface grid'