c-lamp_rewrite: clm_mod.f90@c8ca04c3a9d6

     1 module clm_mod

     3   use netcdf

     4   use kind_mod

     5   implicit none

     7   integer, parameter :: namelen = 128   ! string length for paths

     8   integer, parameter :: varnamelen = 32 ! string length for varnames

     9   integer, parameter :: posnamelen =  4 ! string length for positive attribute

    10   integer, parameter :: varattlen = 128 ! string length for variable attributes

    11   character (len=*), parameter  :: xname  = 'lon'

    12   character (len=*), parameter  :: yname  = 'lat'

    13   character (len=*), parameter  :: zsoi_name  = 'levsoi'

    14   character (len=*), parameter  :: zlak_name  = 'levlak'

    15   character (len=*), parameter  :: tname  = 'time'

    16   character (len=*), parameter  :: hr_name  = 'hour'

    17   character (len=*), parameter  :: nsamples_name  = 'nsamples'

    18   character (len=*), parameter  :: hiname = 'hist_interval'

    19   character (len=*), parameter  :: tbname = 'time_bounds'

    20   character (len=*), parameter  :: aname  = 'area'

    21   character (len=*), parameter  :: lname  = 'landfrac'

    22   character (len=*), parameter  :: mname  = 'landmask'

    23   character (len=*), parameter  :: oname  = 'topo'

    24   character (len=*), parameter  :: long_name_name = 'long_name'

    25   character (len=*), parameter  :: missing_value_name = 'missing_value'

    26   character (len=*), parameter  :: units_name = 'units'

    27   character (len=*), parameter  :: case_id_name = 'case_id'

    28   character (len=*), parameter  :: inidat_name = 'Initial_conditions_dataset'

    29   character (len=*), parameter  :: surdat_name = 'Surface_dataset'

    30   character (len=*), parameter  :: pftdat_name = 'PFT_physiological_constants_dataset'

    31   character (len=*), parameter  :: rtmdat_name = 'RTM_input_datset'

    33   type surface

    34     integer  :: xsize     ! number of longitude points (lon)

    35     integer  :: ysize     ! number of latitutde points (lat)

    36     integer  :: psize     ! number of pfts

    37     real(r8), pointer :: x(:)    ! longitude values (lon)

    38     real(r8), pointer :: y(:)    ! latitude values (lat)

    39     real(r8), pointer :: p(:)    ! pft number

    40     real(r4), pointer :: pft(:,:,:) ! percent of each pft

    41   end type surface

    43   type coordinates

    44     integer  :: xsize     ! number of longitude points (lon)

    45     integer  :: ysize     ! number of latitutde points (lat)

    46     integer  :: zsoi_size ! number of soil z-levels (levsoi)

    47     integer  :: zlak_size ! number of lake z-levels (levlak)

    48     integer  :: tsize     ! number of time points (time)

    49     integer  :: hr_size   ! number of hour points (hour = 24)

    50     integer  :: nsamples  ! number of time samples in post-processing statistics

    51     real(r8), pointer :: x(:)    ! longitude values (lon)

    52     real(r8), pointer :: y(:)    ! latitude values (lat)

    53     real(r8), pointer :: zsoi(:) ! soil z-level values (levsoi)

    54     real(r8), pointer :: zlak(:) ! lake z-level values (levlak)

    55     real(r8), pointer :: hr(:)   ! hour-of-day values (hour)

    56     real(r8), pointer :: area(:,:)     ! gridcell areas

    57     real(r8), pointer :: landfrac(:,:) ! gridcell land fractions

    58     integer, pointer  :: landmask(:,:) ! gridcell land/ocean mask

    59     real(r8), pointer :: orog(:,:)     ! gridcell orography/topography

    60     character (len=namelen) :: case_id ! case name of run

    61     character (len=namelen) :: inidat  ! initial dataset filename

    62     character (len=namelen) :: surdat  ! surface dataset filename

    63     character (len=namelen) :: pftdat  ! pft dataset filename

    64     character (len=namelen) :: rtmdat  ! runoff dataset filename

    65     logical  :: hour_flag ! flag for hour-of-day statistical summary files

    66   end type coordinates

    68   type variable_data

    69     character (len=varnamelen) :: varname

    70     integer           :: ndims

    71     integer, pointer  :: int2d(:,:)

    72     real(r4), pointer :: var2d(:,:)

    73     real(r4), pointer :: var3d(:,:,:)

    74     real(r4), pointer :: var4d(:,:,:,:)

    75     real(r8), pointer :: time(:)

    76     real(r8), pointer :: time_bounds(:,:)

    77     logical  :: int_type ! set if type is integer

    78     logical  :: soil_layer_flag

    79     logical  :: hour_flag ! flag for hour-of-day statistical summary variable

    80     character (len=varattlen)  :: long_name

    81     real(r4)                   :: missing_value

    82     character (len=varattlen)  :: units

    83     character (len=posnamelen) :: positive

    84     character (len=varnamelen) :: out_varname

    85   end type variable_data

    87   type(surface), target       :: surf

    88   type(coordinates), target   :: coord

    89   type(variable_data), target :: var_data

    90   save

    92   public  clm_read_surf

    93   public  clm_free_surf

    94   public  clm_read_coord

    95   public  clm_copy_grid_data

    96   public  clm_read_data

    97   public  clm_convert_data

    98   public  clm_free_data

    99   private nc_err

   101   contains

   103     !

   104     !--------------------------------------------------------------------------

   105     !

   106     subroutine clm_read_surf(fsurdat)

   108     implicit none

   109     character (len=namelen), intent(in) :: fsurdat ! input surface dataset

   110     integer :: i

   111     integer :: ierr

   112     integer :: ncid

   113     integer :: xdimid, xvarid, xlen

   114     integer :: ydimid, yvarid, ylen

   115     integer :: pdimid, pvarid, plen

   116     real(r8), allocatable :: longxy(:,:)

   117     real(r8), allocatable :: latixy(:,:)

   118     real(r4), allocatable :: pctpft(:,:,:)

   120     ! Read coordinated from surface dataset

   121     print *, 'Opening ',trim(fsurdat)

   122     call nc_err(nf90_open(path=trim(fsurdat), mode=nf90_nowrite, ncid=ncid))

   123     call nc_err(nf90_inq_dimid(ncid, 'lsmlon', xdimid))

   124     call nc_err(nf90_inq_dimid(ncid, 'lsmlat', ydimid))

   125     call nc_err(nf90_inq_dimid(ncid, 'lsmpft', pdimid))

   127     call nc_err(nf90_inquire_dimension(ncid=ncid, dimid=xdimid, len=xlen))

   128     call nc_err(nf90_inquire_dimension(ncid=ncid, dimid=ydimid, len=ylen))

   129     call nc_err(nf90_inquire_dimension(ncid=ncid, dimid=pdimid, len=plen))

   131     call nc_err(nf90_inq_varid(ncid, 'LONGXY', xvarid))

   132     call nc_err(nf90_inq_varid(ncid, 'LATIXY', yvarid))

   133     call nc_err(nf90_inq_varid(ncid, 'PCT_PFT', pvarid))

   135     allocate(longxy(xlen, ylen), latixy(xlen, ylen), pctpft(xlen, ylen, plen), stat=ierr)

   136     if (ierr /= 0) then

   137        print *, 'clm_read_surf: Cannot allocate longxy, latixy, pctpft variables'

   138        stop

   139     end if

   141     call nc_err(nf90_get_var(ncid, xvarid, longxy))

   142     call nc_err(nf90_get_var(ncid, yvarid, latixy))

   143     call nc_err(nf90_get_var(ncid, pvarid, pctpft))

   145     print *, 'Closing ',trim(fsurdat)

   146     call nc_err(nf90_close(ncid))

   148     ! Allocate and fill in the surface derived data type

   149     surf%xsize = xlen

   150     surf%ysize = ylen

   151     surf%psize = plen

   152     allocate(surf%x(xlen), surf%y(ylen), surf%p(plen), surf%pft(xlen, ylen, plen), stat=ierr)

   153     if (ierr /= 0) then

   154        print *, 'clm_read_surf: Cannot allocate surface type variables'

   155        stop

   156     end if

   157     surf%x(:) = longxy(:,1)

   158     surf%y(:) = latixy(1,:)

   159     do i = 1, plen

   160        surf%p(i) = real(i)

   161     end do

   162     surf%pft  = pctpft

   164     deallocate(longxy, latixy, pctpft)

   166     end subroutine clm_read_surf

   167     !

   168     !--------------------------------------------------------------------------

   169     !

   170     subroutine clm_free_surf()

   172     implicit none

   174     if (allocated(surf%x))   deallocate(surf%x)

   175     if (allocated(surf%y))   deallocate(surf%y)

   176     if (allocated(surf%p))   deallocate(surf%p)

   177     if (allocated(surf%pft)) deallocate(surf%pft)

   179     end subroutine clm_free_surf

   180     !

   181     !--------------------------------------------------------------------------

   182     !

   183     subroutine clm_read_coord(numf, input_path, fnames, read_grid_all)

   185     implicit none

   186     integer, intent(in)                 :: numf          ! number of filenames

   187     character (len=namelen), intent(in) :: input_path    ! input path

   188     character (len=namelen), intent(in) :: fnames(numf)  ! input filenames

   189     logical, intent(in)                 :: read_grid_all ! flag to read area,...

   190     integer :: ncid

   191     integer :: xdimid, xvarid, xlen

   192     integer :: ydimid, yvarid, ylen

   193     integer :: zsoi_dimid, zsoi_varid, zsoi_len

   194     integer :: zlak_dimid, zlak_varid, zlak_len

   195     integer :: tdimid, tvarid, tlen

   196     integer :: hr_dimid, hr_varid, hr_len

   197     integer :: nsamples_dimid, nsamples_len

   198     integer :: avarid ! area (when read_grid_all true)

   199     integer :: lvarid ! landfrac (when read_grid_all true)

   200     integer :: mvarid ! landmask (when read_grid_all true)

   201     integer :: ovarid ! orog/topo (when read_grid_all true)

   202     integer(i8) :: i

   203     integer(i8) :: time_size

   204     real(r4), allocatable :: xvals(:)

   205     real(r4), allocatable :: yvals(:)

   206     real(r4), allocatable :: zsoi_vals(:)

   207     real(r4), allocatable :: zlak_vals(:)

   208     real(r4), allocatable :: hr_vals(:)

   209     real(r4), allocatable :: avals(:,:) ! area (when read_grid_all true)

   210     real(r4), allocatable :: lvals(:,:) ! landfrac (when read_grid_all true)

   211     integer, allocatable  :: mvals(:,:) ! landmask (when read_grid_all true)

   212     real(r4), allocatable :: ovals(:,:) ! orog/topo (when read_grid_all true)

   213     character (len=namelen) :: case_id = ''

   214     character (len=namelen) :: inidat = ''

   215     character (len=namelen) :: surdat = ''

   216     character (len=namelen) :: pftdat = ''

   217     character (len=namelen) :: rtmdat = ''

   218     logical :: hrflag = .false.

   219     integer :: ierr

   221     ! Read coordinates from first file

   222     print *, 'Opening ',trim(input_path)//'/'//trim(fnames(1))

   223     call nc_err(nf90_open(path=trim(input_path)//'/'//trim(fnames(1)), mode=nf90_nowrite, ncid=ncid))

   224     call nc_err(nf90_inq_dimid(ncid, xname, xdimid))

   225     call nc_err(nf90_inq_dimid(ncid, yname, ydimid))

   226     call nc_err(nf90_inq_dimid(ncid, zsoi_name, zsoi_dimid))

   227     call nc_err(nf90_inq_dimid(ncid, zlak_name, zlak_dimid))

   228     call nc_err(nf90_inq_dimid(ncid, tname, tdimid))

   229     if (nf90_inq_dimid(ncid, hr_name, hr_dimid) == nf90_noerr) then

   230        call nc_err(nf90_inq_dimid(ncid, nsamples_name, nsamples_dimid))

   231        hrflag = .true.

   232     end if

   234     call nc_err(nf90_inquire_dimension(ncid=ncid, dimid=xdimid, len=xlen))

   235     call nc_err(nf90_inquire_dimension(ncid=ncid, dimid=ydimid, len=ylen))

   236     call nc_err(nf90_inquire_dimension(ncid=ncid, dimid=zsoi_dimid, len=zsoi_len))

   237     call nc_err(nf90_inquire_dimension(ncid=ncid, dimid=zlak_dimid, len=zlak_len))

   238     call nc_err(nf90_inquire_dimension(ncid=ncid, dimid=tdimid, len=tlen))

   239     if (hrflag) then

   240        call nc_err(nf90_inquire_dimension(ncid=ncid, dimid=hr_dimid, len=hr_len))

   241        call nc_err(nf90_inquire_dimension(ncid=ncid, dimid=nsamples_dimid, len=nsamples_len))

   242     else

   243        hr_len = 0

   244        nsamples_len = 0

   245     end if

   246     print *, tlen,' values'

   248     allocate(xvals(xlen), yvals(ylen), zsoi_vals(zsoi_len), zlak_vals(zlak_len), hr_vals(hr_len), stat=ierr)

   249     if (ierr /= 0) then

   250        print *, 'clm_read_coord: Cannot allocate grid variables'

   251        stop

   252     end if

   253     if (read_grid_all) then

   254        allocate(avals(xlen, ylen), lvals(xlen, ylen), mvals(xlen, ylen), ovals(xlen, ylen), stat=ierr)

   255        if (ierr /= 0) then

   256           print *, 'clm_read_coord: Cannot allocate extra grid variables'

   257           stop

   258        end if

   259     end if

   261     call nc_err(nf90_inq_varid(ncid, xname, xvarid))

   262     call nc_err(nf90_inq_varid(ncid, yname, yvarid))

   263     call nc_err(nf90_inq_varid(ncid, zsoi_name, zsoi_varid))

   264     call nc_err(nf90_inq_varid(ncid, zlak_name, zlak_varid))

   265     call nc_err(nf90_inq_varid(ncid, tname, tvarid))

   266     if (hrflag) call nc_err(nf90_inq_varid(ncid, hr_name, hr_varid))

   267     if (read_grid_all) then

   268        call nc_err(nf90_inq_varid(ncid, aname, avarid))

   269        call nc_err(nf90_inq_varid(ncid, lname, lvarid))

   270        call nc_err(nf90_inq_varid(ncid, mname, mvarid))

   271        call nc_err(nf90_inq_varid(ncid, oname, ovarid))

   272     end if

   274     call nc_err(nf90_get_var(ncid, xvarid, xvals))

   275     call nc_err(nf90_get_var(ncid, yvarid, yvals))

   276     call nc_err(nf90_get_var(ncid, zsoi_varid, zsoi_vals))

   277     call nc_err(nf90_get_var(ncid, zlak_varid, zlak_vals))

   278     if (hrflag) call nc_err(nf90_get_var(ncid, hr_varid, hr_vals))

   279     if (read_grid_all) then

   280        call nc_err(nf90_get_var(ncid, avarid, avals))

   281        call nc_err(nf90_get_var(ncid, lvarid, lvals))

   282        call nc_err(nf90_get_var(ncid, mvarid, mvals))

   283        call nc_err(nf90_get_var(ncid, ovarid, ovals))

   284     end if

   286     ! Read global attributes

   287     call nc_err(nf90_get_att(ncid, nf90_global, case_id_name, case_id))

   288     call nc_err(nf90_get_att(ncid, nf90_global, inidat_name, inidat))

   289     call nc_err(nf90_get_att(ncid, nf90_global, surdat_name, surdat))

   290     call nc_err(nf90_get_att(ncid, nf90_global, pftdat_name, pftdat))

   291     call nc_err(nf90_get_att(ncid, nf90_global, rtmdat_name, rtmdat))

   293     call nc_err(nf90_close(ncid))

   295     time_size = tlen

   296     ! Loop over all remaining files, reading size of time dimension

   297     do i = 2, numf

   298       print *, 'Opening ',trim(input_path)//'/'//trim(fnames(i))

   299       call nc_err(nf90_open(path=trim(input_path)//'/'//trim(fnames(i)), &

   300          mode=nf90_nowrite, ncid=ncid))

   301       call nc_err(nf90_inq_dimid(ncid, tname, tdimid))

   302       call nc_err(nf90_inquire_dimension(ncid=ncid, dimid=tdimid, len=tlen))

   303       call nc_err(nf90_close(ncid))

   304       print *, tlen,' values'

   305       time_size = time_size + tlen

   306     end do

   308     ! Allocate and fill the coordinates derived data type

   309     coord%xsize = xlen

   310     coord%ysize = ylen

   311     coord%zsoi_size = zsoi_len

   312     coord%zlak_size = zlak_len

   313     coord%tsize = time_size

   314     coord%hr_size = hr_len

   315     coord%nsamples = nsamples_len

   316     allocate(coord%x(xlen), coord%y(ylen), coord%zsoi(zsoi_len), coord%zlak(zlak_len), coord%hr(hr_len), stat=ierr)

   317     if (ierr /= 0) then

   318        print *, 'clm_read_coord: Cannot allocate grid variables'

   319        stop

   320     end if

   321     if (read_grid_all) then

   322        allocate(coord%area(xlen, ylen), coord%landfrac(xlen, ylen), coord%landmask(xlen, ylen), coord%orog(xlen, ylen), stat=ierr)

   323        if (ierr /= 0) then

   324           print *, 'clm_read_coord: Cannot allocate extra grid variables'

   325           stop

   326        end if

   327     end if

   328     coord%x = xvals

   329     coord%y = yvals

   330     coord%zsoi = zsoi_vals

   331     coord%zlak = zlak_vals

   332     if (hrflag) coord%hr = hr_vals

   333     if (read_grid_all) then

   334        coord%area = avals

   335        coord%landfrac = lvals

   336        coord%landmask = mvals

   337        coord%orog = ovals

   338     end if

   339     deallocate(xvals, yvals, zsoi_vals, zlak_vals, hr_vals)

   340     if (read_grid_all) then

   341        deallocate(avals, lvals, mvals, ovals)

   342     end if

   343     coord%case_id = trim(case_id)

   344     coord%inidat = trim(inidat)

   345     coord%surdat = trim(surdat)

   346     coord%pftdat = trim(pftdat)

   347     coord%rtmdat = trim(rtmdat)

   348     coord%hour_flag = hrflag

   350     end subroutine clm_read_coord

   351     !

   352     !--------------------------------------------------------------------------

   353     !

   354     subroutine clm_copy_grid_data(varname)

   356     implicit none

   357     character (len=varnamelen), intent(in) :: varname      ! variable name

   358     integer :: ierr

   360     var_data%varname       = varname

   361     var_data%ndims         = 2

   362     var_data%missing_value = 1.0e+36

   363     if (varname == 'landmask') then

   364        var_data%int_type = .true.

   365        allocate(var_data%int2d(coord%xsize, coord%ysize), stat=ierr)

   366        if (ierr /= 0) then

   367          print *, 'clm_copy_grid_data: Cannot allocate 2d integer variable'

   368          stop

   369        end if

   370     else

   371        var_data%int_type = .false.

   372        allocate(var_data%var2d(coord%xsize, coord%ysize), stat=ierr)

   373        if (ierr /= 0) then

   374          print *, 'clm_copy_grid_data: Cannot allocate 2d real variable'

   375          stop

   376        end if

   377     end if

   379     select case (varname)

   380        case ('area')

   381           var_data%var2d = coord%area

   382        case ('landfrac')

   383           var_data%var2d = coord%landfrac

   384        case ('landmask')

   385           var_data%int2d = coord%landmask

   386        case ('topo')

   387           var_data%var2d = coord%orog

   388        case default

   389           print *,'clm_copy_grid_data: ',varname,' is not a known grid variable'

   390           stop

   391     end select

   393     end subroutine clm_copy_grid_data

   394     !

   395     !--------------------------------------------------------------------------

   396     !

   397     subroutine clm_read_data(numf, input_path, fnames, tshift, varname)

   399     implicit none

   400     integer, intent(in)                    :: numf         ! number of filenames

   401     character (len=namelen), intent(in)    :: input_path   ! input path

   402     character (len=namelen), intent(in)    :: fnames(numf) ! input filenames

   403     integer, intent(in)                    :: tshift(numf) ! time shift by file

   404     character (len=varnamelen), intent(in) :: varname      ! variable name

   405     integer :: ncid

   406     integer :: tdimid, tvarid, tlen

   407     integer :: hidimid, hilen

   408     integer :: tbvarid

   409     integer :: varid, dimids(nf90_max_var_dims), dimlen

   410     integer :: zsize

   411     integer(i8) :: i, j, k, l

   412     integer(i8) :: time_size

   413     real(r4), allocatable :: tvals(:)    ! temporary time values

   414     real(r4), allocatable :: tbvals(:,:) ! temporary time bounds values

   415     real(r4), allocatable :: vals(:,:)   ! temporary data values

   416     character (len=varnamelen) :: dimname      ! dimension name

   417     integer :: ierr

   419     ! Figure out the dimensionality of the variable and variable attributes

   420     ! from the first file

   421     print *, 'Opening ',trim(input_path)//'/'//trim(fnames(1)), &

   422        ' to check dimensionality of ',trim(varname)

   423     call nc_err(nf90_open(path=trim(input_path)//'/'//trim(fnames(1)), mode=nf90_nowrite, ncid=ncid))

   424     call nc_err(nf90_inq_varid(ncid, trim(varname), varid))

   425     call nc_err(nf90_inquire_variable(ncid, varid, name=var_data%varname, ndims=var_data%ndims, dimids=dimids))

   426     ! Figure out if there is a Z-dimension and/or an hour-dimension

   427     ierr = 0

   428     var_data%int_type = .false.

   429     var_data%hour_flag = .false.

   430     var_data%soil_layer_flag = .false.

   431     do i = 1, var_data%ndims

   432        call nc_err(nf90_inquire_dimension(ncid, dimids(i), name=dimname, len=dimlen))

   433        if (i == 1 .and. dimname /= xname) ierr = ierr + 1

   434        if (i == 2 .and. dimname /= yname) ierr = ierr + 1

   435        if (i > 2 .and. i < var_data%ndims) then

   436           if (dimname == hr_name) then

   437              var_data%hour_flag = .true.

   438           else if (dimname == zsoi_name) then

   439              var_data%soil_layer_flag = .true.

   440           !else if (dimname == zlak_name) then

   441           !   var_data%zdim_name = dimname

   442           else

   443              ierr = ierr + 1

   444           end if

   445        end if

   446        ! This is not a good assumption (that time is always there), so skip it

   447        !if (i == var_data%ndims .and. dimname /= tname) ierr = ierr + 1

   448        print *,'Dimension ',i,' is ',dimname

   449     end do

   450     if (ierr /= 0) then

   451        print *,'clm_read_data: Unexpected dimension combination'

   452        stop

   453     end if

   454     !

   455     call nc_err(nf90_get_att(ncid, varid, long_name_name, var_data%long_name))

   456     call nc_err(nf90_get_att(ncid, varid, missing_value_name, var_data%missing_value))

   457     call nc_err(nf90_get_att(ncid, varid, units_name, var_data%units))

   458     call nc_err(nf90_close(ncid))

   460     ! Allocate space for the variable of the correct dimensionality

   461     select case (var_data%ndims)

   462       case (2)

   463         allocate(var_data%var2d(coord%xsize, coord%ysize), stat=ierr)

   464         if (ierr /= 0) then

   465           print *, 'clm_read_data: Cannot allocate 2d variable'

   466           stop

   467         end if

   468       case (3)

   469         allocate(var_data%var3d(coord%xsize, coord%ysize, coord%tsize), stat=ierr)

   470         if (ierr /= 0) then

   471           print *, 'clm_read_data: Cannot allocate 3d variable'

   472           stop

   473         end if

   474       case (4)

   475         if (var_data%hour_flag) then

   476           zsize = coord%hr_size

   477         else if (var_data%soil_layer_flag) then

   478           zsize = coord%zsoi_size

   479         !else if (var_data%zdim_name == zlak_name) then

   480         !   zsize = coord%zlak_size

   481         else

   482           print *,'clm_read_data: Unexpected fourth dimension while allocating'

   483           stop

   484         end if

   485         allocate(var_data%var4d(coord%xsize, coord%ysize, zsize, coord%tsize), stat=ierr)

   486         if (ierr /= 0) then

   487           print *, 'clm_read_data: Cannot allocate 4d variable'

   488           stop

   489         end if

   490       case default

   491         print *, 'clm_read_data: Cannot handle variables of ', var_data%ndims, ' dimensions'

   492         stop

   493     end select

   495     ! Allocate space for time stamps and bounds

   496     allocate(var_data%time(coord%tsize), stat=ierr)

   497     if (ierr /= 0) then

   498       print *, 'clm_read_data: Cannot allocate time variable'

   499       stop

   500     end if

   501     allocate(var_data%time_bounds(2,coord%tsize), stat=ierr)

   502     if (ierr /= 0) then

   503       print *, 'clm_read_data: Cannot allocate time bounds variable'

   504       stop

   505     end if

   507     ! Allocate temporary space for the variable level-slice/time-slice */

   508     allocate(vals(coord%xsize, coord%ysize), stat=ierr)

   509     if (ierr /= 0) then

   510       print *, 'clm_read_data: Cannot allocate variable time-slice'

   511       stop

   512     end if

   514     if (var_data%ndims == 2) then

   515       ! No time axis, so just read the first instance from the first file

   516       print *, 'Opening ',trim(input_path)//'/'//trim(fnames(1))

   517       call nc_err(nf90_open(path=trim(input_path)//'/'//trim(fnames(1)), mode=nf90_nowrite, ncid=ncid))

   518       call nc_err(nf90_inq_varid(ncid, trim(varname), varid))

   519       call nc_err(nf90_get_var(ncid, varid, vals, start = (/ 1, 1 /), count = (/ coord%xsize, coord%ysize /)))

   520       var_data%var2d(:,:) = vals(:,:)

   521       call nc_err(nf90_close(ncid))

   522     else

   523       ! Otherwise, loop over all times

   524       time_size = 0

   525       ! Loop over all files, reading data

   526       do i = 1, numf

   527         print *, 'Opening ',trim(input_path)//'/'//trim(fnames(i))

   528         call nc_err(nf90_open(path=trim(input_path)//'/'//trim(fnames(i)), mode=nf90_nowrite, ncid=ncid))

   529         call nc_err(nf90_inq_dimid(ncid, tname, tdimid))

   530         call nc_err(nf90_inquire_dimension(ncid=ncid, dimid=tdimid, len=tlen))

   531         call nc_err(nf90_inq_dimid(ncid, hiname, hidimid))

   532         call nc_err(nf90_inquire_dimension(ncid=ncid, dimid=hidimid, len=hilen))

   534         call nc_err(nf90_inq_varid(ncid, tname, tvarid))

   535         call nc_err(nf90_inq_varid(ncid, tbname, tbvarid))

   536         call nc_err(nf90_inq_varid(ncid, trim(varname), varid))

   538         ! Allocate temporary space for the time stamps and bounds

   539         allocate(tvals(tlen), stat=ierr)

   540         if (ierr /= 0) then

   541           print *, 'clm_read_data: Cannot allocate temporary time variable'

   542           stop

   543         end if

   544         allocate(tbvals(hilen,tlen), stat=ierr)

   545         if (ierr /= 0) then

   546           print *, 'clm_read_data: Cannot allocate temporary time bounds variable'

   547           stop

   548         end if

   550         ! Get the time stamps and bounds

   551         call nc_err(nf90_get_var(ncid, tvarid, tvals))

   552         call nc_err(nf90_get_var(ncid, tbvarid, tbvals))

   554         do j = 1, tlen

   555           ! Get and store a slab of data

   556           select case (var_data%ndims)

   557             case (3)

   558               !print *, 'Reading slice of data'

   559               call nc_err(nf90_get_var(ncid, varid, vals, start = (/ 1, 1, j /), count = (/ coord%xsize, coord%ysize, 1 /)))

   560               var_data%var3d(:,:,time_size + j) = vals(:,:)

   561             case (4)

   562               do k = 1, zsize

   563                  call nc_err(nf90_get_var(ncid, varid, vals, start = (/ 1, 1, k, j /), count = (/ coord%xsize, coord%ysize, 1, 1 /)))

   564                  var_data%var4d(:,:,k,time_size + j) = vals(:,:)

   565               end do

   566             case default

   567               print *, 'clm_read_data: Cannot handle variables of ', var_data%ndims, ' dimensions'

   568               stop

   569           end select

   570           ! Store each time stamp and bounds, including the time offset

   571           var_data%time(time_size + j) = tvals(j) + tshift(i)

   572           var_data%time_bounds(:,time_size + j) = tbvals(:,j) + tshift(i)

   574         end do

   576         call nc_err(nf90_close(ncid))

   578         deallocate(tvals)

   579         deallocate(tbvals)

   581         time_size = time_size + tlen

   583       end do

   584     end if

   586     deallocate(vals)

   588     end subroutine clm_read_data

   589     !

   590     !--------------------------------------------------------------------------

   591     !

   592     subroutine clm_convert_data(casa_flux_bug)

   594     implicit none

   595     logical, intent(in)  :: casa_flux_bug

   596     real(r8)             :: sfactor

   597     real(r8)             :: offset

   598     integer              :: ierr

   599     logical, allocatable :: mask2d(:,:)

   600     logical, allocatable :: mask3d(:,:,:)

   601     logical, allocatable :: mask4d(:,:,:,:)

   603     ! Default offset is zero

   604     offset = 0.

   606     ! Default var_data structure values

   607     var_data%positive = ''

   609     ! Set scale factor according to which variable is to be converted

   610     select case (var_data%varname)

   612       !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

   613       ! Atmospheric forcing

   614       !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

   615       ! husf

   616       case ('QBOT')

   617         ! QBOT: kg kg-1 -> kg kg-1

   618         sfactor = 1.0

   619         var_data%units = 'kg kg-1'

   620         var_data%out_varname = 'husf'

   621       ! prra

   622       case ('RAIN')

   623         ! RAIN: mm s-1 -> kg m-2 s-1

   624         sfactor = 1.0

   625         var_data%units = 'kg m-2 s-1'

   626         var_data%out_varname = 'prra'

   627       ! prsn

   628       case ('SNOW')

   629         ! SNOW: mm s-1 -> kg m-2 s-1

   630         sfactor = 1.0

   631         var_data%units = 'kg m-2 s-1'

   632         var_data%out_varname = 'prsn'

   634       !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

   635       ! Biogeochemistry

   636       !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

   637       ! agbc

   638       ! aglbc

   639       ! agnpp

   640       case ('AGNPP')

   641         ! AGNPP: g m-2 s-1 -> kg m-2 s-1

   642         sfactor = 1.0e-3

   643         var_data%units = 'kg m-2 s-1'

   644         var_data%out_varname = 'agnpp'

   645       ! ar

   646       case ('AR')

   647         ! AR: g m-2 s-1 -> kg m-2 s-1

   648         sfactor = 1.0e-3

   649         var_data%units = 'kg m-2 s-1'

   650         var_data%out_varname = 'ar'

   651       ! bco

   652       case ('BIOGENCO')

   653         ! BIOGENCO: ug m-2 h-1 -> kg m-2 s-1

   654         sfactor = 1.0e-9 * (1.0 / 3600.)

   655         var_data%units = 'kg m-2 s-1'

   656         var_data%out_varname = 'bco'

   657       ! bgbc

   658       ! bgnpp

   659       case ('BGNPP')

   660         ! BGNPP: g m-2 s-1 -> kg m-2 s-1

   661         sfactor = 1.0e-3

   662         var_data%units = 'kg m-2 s-1'

   663         var_data%out_varname = 'bgnpp'

   664       ! bipn

   665       case ('ISOPRENE')

   666         ! ISOPRENE: ug m-2 h-1 -> kg m-2 s-1

   667         sfactor = 1.0e-9 * (1.0 / 3600.)

   668         var_data%units = 'kg m-2 s-1'

   669         var_data%out_varname = 'bipn'

   670       ! bmtpn

   671       case ('MONOTERP')

   672         ! MONOTERP: ug m-2 h-1 -> kg m-2 s-1

   673         sfactor = 1.0e-9 * (1.0 / 3600.)

   674         var_data%units = 'kg m-2 s-1'

   675         var_data%out_varname = 'bmtpn'

   676       ! borvoc

   677       case ('ORVOC')

   678         ! ORVOC: ug m-2 h-1 -> kg m-2 s-1

   679         sfactor = 1.0e-9 * (1.0 / 3600.)

   680         var_data%units = 'kg m-2 s-1'

   681         var_data%out_varname = 'borvoc'

   682       ! bovoc

   683       case ('OVOC')

   684         ! OVOC: ug m-2 h-1 -> kg m-2 s-1

   685         sfactor = 1.0e-9 * (1.0 / 3600.)

   686         var_data%units = 'kg m-2 s-1'

   687         var_data%out_varname = 'bovoc'

   688       ! cwdc

   689       case ('CWDC')

   690         ! CWDC: g m-2 -> kg m-2

   691         sfactor = 1.0e-3

   692         var_data%units = 'kg m-2'

   693         var_data%out_varname = 'cwdc'

   694       ! cwdc_hr

   695       case ('CWDC_HR')

   696         ! CWDC_HR: g m-2 s-1 -> kg m-2 s-1

   697         sfactor = 1.0e-3

   698         var_data%units = 'kg m-2 s-1'

   699         var_data%out_varname = 'cwdc_hr'

   700       ! cwdc_loss

   701       case ('CWDC_LOSS')

   702         ! CWDC_LOSS: g m-2 s-1 -> kg m-2 s-1

   703         sfactor = 1.0e-3

   704         if (casa_flux_bug) then

   705            print *,'WARNING: casa_flux_bug set to true; dividing data by 1200'

   706            sfactor = sfactor * (1. / 1200.)

   707         end if

   708         var_data%units = 'kg m-2 s-1'

   709         var_data%out_varname = 'cwdc_loss'

   710       ! froot_litterc

   711       ! froot_litterc_hr

   712       ! froot_litterc_loss

   713       ! frootc

   714       case ('FROOTC')

   715         ! FROOTC: g m-2 -> kg m-2

   716         sfactor = 1.0e-3

   717         var_data%units = 'kg m-2'

   718         var_data%out_varname = 'frootc'

   719       ! frootc_alloc

   720       case ('FROOTC_ALLOC')

   721         ! FROOTC_ALLOC: g m-2 s-1 -> kg m-2 s-1

   722         sfactor = 1.0e-3

   723         if (casa_flux_bug) then

   724            print *,'WARNING: casa_flux_bug set to true; dividing data by 1200'

   725            sfactor = sfactor * (1. / 1200.)

   726         end if

   727         var_data%units = 'kg m-2 s-1'

   728         var_data%out_varname = 'frootc_alloc'

   729       ! frootc_loss

   730       case ('FROOTC_LOSS')

   731         ! FROOTC_LOSS: g m-2 s-1 -> kg m-2 s-1

   732         sfactor = 1.0e-3

   733         if (casa_flux_bug) then

   734            print *,'WARNING: casa_flux_bug set to true; dividing data by 1200'

   735            sfactor = sfactor * (1. / 1200.)

   736         end if

   737         var_data%units = 'kg m-2 s-1'

   738         var_data%out_varname = 'frootc_loss'

   739       ! gpp

   740       case ('GPP')

   741         ! GPP: g m-2 s-1 -> kg m-2 s-1

   742         sfactor = 1.0e-3

   743         var_data%units = 'kg m-2 s-1'

   744         var_data%out_varname = 'gpp'

   745       ! gnmin

   746       case ('GROSS_NMIN')

   747         ! GROSS_NMIN: g m-2 s-1 -> kg m-2 s-1

   748         sfactor = 1.0e-3

   749         var_data%units = 'kg m-2 s-1'

   750         var_data%out_varname = 'gnmin'

   751       ! hr

   752       case ('HR')

   753         ! HR: g m-2 s-1 -> kg m-2 s-1

   754         sfactor = 1.0e-3

   755         var_data%units = 'kg m-2 s-1'

   756         var_data%out_varname = 'hr'

   757       ! leaf_litterc

   758       ! leaf_litterc_hr

   759       ! leaf_litterc_loss

   760       ! leafc

   761       case ('LEAFC')

   762         ! LEAFC: g m-2 -> kg m-2

   763         sfactor = 1.0e-3

   764         var_data%units = 'kg m-2'

   765         var_data%out_varname = 'leafc'

   766       ! leafc_alloc

   767       case ('LEAFC_ALLOC')

   768         ! LEAFC_ALLOC: g m-2 s-1 -> kg m-2 s-1

   769         sfactor = 1.0e-3

   770         if (casa_flux_bug) then

   771            print *,'WARNING: casa_flux_bug set to true; dividing data by 1200'

   772            sfactor = sfactor * (1. / 1200.)

   773         end if

   774         var_data%units = 'kg m-2 s-1'

   775         var_data%out_varname = 'leafc_alloc'

   776       ! leafc_loss

   777       case ('LEAFC_LOSS')

   778         ! LEAFC_LOSS: g m-2 s-1 -> kg m-2 s-1

   779         sfactor = 1.0e-3

   780         if (casa_flux_bug) then

   781            print *,'WARNING: casa_flux_bug set to true; dividing data by 1200'

   782            sfactor = sfactor * (1. / 1200.)

   783         end if

   784         var_data%units = 'kg m-2 s-1'

   785         var_data%out_varname = 'leafc_loss'

   786       ! litterc

   787       case ('LITTERC')

   788         ! LITTERC: g m-2 -> kg m-2

   789         sfactor = 1.0e-3

   790         var_data%units = 'kg m-2'

   791         var_data%out_varname = 'litterc'

   792       ! litterc_hr

   793       case ('LITTERC_HR')

   794         ! LITTERC_HR: g m-2 s-1 -> kg m-2 s-1

   795         sfactor = 1.0e-3

   796         var_data%units = 'kg m-2 s-1'

   797         var_data%out_varname = 'litterc_hr'

   798       ! litterc_loss

   799       case ('LITTERC_LOSS')

   800         ! LITTERC_LOSS: g m-2 s-1 -> kg m-2 s-1

   801         sfactor = 1.0e-3

   802         if (casa_flux_bug) then

   803            print *,'WARNING: casa_flux_bug set to true; dividing data by 1200'

   804            sfactor = sfactor * (1. / 1200.)

   805         end if

   806         var_data%units = 'kg m-2 s-1'

   807         var_data%out_varname = 'litterc_loss'

   808       ! nee

   809       case ('NEE')

   810         ! NEE: g m-2 s-1 -> kg m-2 s-1

   811         sfactor = 1.0e-3

   812         var_data%units = 'kg m-2 s-1'

   813         var_data%out_varname = 'nee'

   814       ! nep

   815       case ('NEP')

   816         ! NEP: g m-2 s-1 -> kg m-2 s-1

   817         sfactor = 1.0e-3

   818         var_data%units = 'kg m-2 s-1'

   819         var_data%out_varname = 'nep'

   820       ! nnmin

   821       case ('NET_NMIN')

   822         ! NEP: g m-2 s-1 -> kg m-2 s-1

   823         sfactor = 1.0e-3

   824         var_data%units = 'kg m-2 s-1'

   825         var_data%out_varname = 'nnmin'

   826       ! npp

   827       case ('NPP')

   828         ! NPP: g m-2 s-1 -> kg m-2 s-1

   829         sfactor = 1.0e-3

   830         var_data%units = 'kg m-2 s-1'

   831         var_data%out_varname = 'npp'

   832       ! soilc

   833       case ('SOILC')

   834         ! SOILC: g m-2 -> kg m-2

   835         sfactor = 1.0e-3

   836         var_data%units = 'kg m-2'

   837         var_data%out_varname = 'soilc'

   838       ! soilc_hr

   839       case ('SOILC_HR')

   840         ! SOILC_HR: g m-2 s-1 -> kg m-2 s-1

   841         sfactor = 1.0e-3

   842         var_data%units = 'kg m-2 s-1'

   843         var_data%out_varname = 'soilc_hr'

   844       ! soilc_loss

   845       case ('SOILC_LOSS')

   846         ! SOILC_LOSS: g m-2 s-1 -> kg m-2 s-1

   847         sfactor = 1.0e-3

   848         if (casa_flux_bug) then

   849            print *,'WARNING: casa_flux_bug set to true; dividing data by 1200'

   850            sfactor = sfactor * (1. / 1200.)

   851         end if

   852         var_data%units = 'kg m-2 s-1'

   853         var_data%out_varname = 'soilc_loss'

   854       ! tbvoc

   855       case ('VOCFLXT')

   856         ! VOCFLXT: ug m-2 h-1 -> kg m-2 s-1

   857         sfactor = 1.0e-9 * (1.0 / 3600.)

   858         var_data%units = 'kg m-2 s-1'

   859         var_data%out_varname = 'tbvoc'

   860       ! woodc

   861       case ('WOODC')

   862         ! WOODC: g m-2 -> kg m-2

   863         sfactor = 1.0e-3

   864         var_data%units = 'kg m-2'

   865         var_data%out_varname = 'woodc'

   866       ! woodc_alloc

   867       case ('WOODC_ALLOC')

   868         ! WOODC_ALLOC: g m-2 s-1 -> kg m-2 s-1

   869         sfactor = 1.0e-3

   870         if (casa_flux_bug) then

   871            print *,'WARNING: casa_flux_bug set to true; dividing data by 1200'

   872            sfactor = sfactor * (1. / 1200.)

   873         end if

   874         var_data%units = 'kg m-2 s-1'

   875         var_data%out_varname = 'woodc_alloc'

   876       ! woodc_loss

   877       case ('WOODC_LOSS')

   878         ! WOODC_LOSS: g m-2 s-1 -> kg m-2 s-1

   879         sfactor = 1.0e-3

   880         if (casa_flux_bug) then

   881            print *,'WARNING: casa_flux_bug set to true; dividing data by 1200'

   882            sfactor = sfactor * (1. / 1200.)

   883         end if

   884         var_data%units = 'kg m-2 s-1'

   885         var_data%out_varname = 'woodc_loss'

   887       !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

   888       ! Energy

   889       !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

   890       ! hfg

   891       case ('FGR')

   892         ! FGR: W m-2 -> W m-2

   893         sfactor = 1.0

   894         var_data%units = 'W m-2'

   895         var_data%positive = 'down'

   896         var_data%out_varname = 'hfg'

   897       ! hfls

   898       case ('LATENT')

   899         ! LATENT: W m-2 -> W m-2

   900         sfactor = 1.0

   901         var_data%units = 'W m-2'

   902         var_data%positive = 'up'

   903         var_data%out_varname = 'hfls'

   904       ! hfss

   905       case ('FSH')

   906         ! FSH: W m-2 -> W m-2

   907         sfactor = 1.0

   908         var_data%units = 'W m-2'

   909         var_data%positive = 'up'

   910         var_data%out_varname = 'hfss'

   911       ! hfssg

   912       case ('FSH_G')

   913         ! FSH_G: W m-2 -> W m-2

   914         sfactor = 1.0

   915         var_data%units = 'W m-2'

   916         var_data%positive = 'up'

   917         var_data%out_varname = 'hfssg'

   918       ! hfssv

   919       case ('FSH_V')

   920         ! FSH_V: W m-2 -> W m-2

   921         sfactor = 1.0

   922         var_data%units = 'W m-2'

   923         var_data%positive = 'up'

   924         var_data%out_varname = 'hfssv'

   926       !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

   927       ! Grid

   928       !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

   929       ! gca

   930       case ('area')

   931         ! area: km2 -> m2

   932         sfactor = 1.0e+3

   933         var_data%units = 'm2'

   934         var_data%out_varname = 'gca'

   935       ! lbm

   936       case ('landmask')

   937         ! landmask: 1 -> 1

   938         var_data%units = '1'

   939         var_data%out_varname = 'lbm'

   940         ! Do not convert integer landmask, just return

   941         return

   942       ! lcf

   943       ! lcn

   944       ! orog

   945       case ('topo')

   946         ! topo: m -> m

   947         sfactor = 1.0

   948         var_data%units = 'm'

   949         var_data%out_varname = 'orog'

   950       ! sftlf

   951       case ('landfrac')

   952         ! landfrac: 1 -> 1

   953         sfactor = 1.0

   954         var_data%units = '1'

   955         var_data%out_varname = 'sftlf'

   957       !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

   958       ! Humidity

   959       !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

   960       ! hur2m

   961       case ('RH2M')

   962         ! RH2M: % -> %

   963         sfactor = 1.0

   964         var_data%units = '%'

   965         var_data%out_varname = 'hur2m'

   966       ! hus2m

   967       case ('Q2M')

   968         ! Q2M: kg kg-1 -> kg kg-1

   969         sfactor = 1.0

   970         var_data%units = 'kg kg-1'

   971         var_data%out_varname = 'hus2m'

   973       !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

   974       ! Hydrology

   975       !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

   976       ! btran

   977       case ('BTRAN')

   978         ! BTRAN: 1 -> 1

   979         sfactor = 1.0

   980         var_data%units = '1'

   981         var_data%out_varname = 'btran'

   982       ! et

   983       case ('ET')

   984         ! ET: m s-1 -> kg m-2 s-1

   985         sfactor = 1.0e+3

   986         var_data%units = 'kg m-2 s-1'

   987         var_data%out_varname = 'et'

   988       ! evspsblsoi

   989       case ('QSOIL')

   990         ! QSOIL: mm s-1 -> kg m-2 s-1

   991         sfactor = 1.0

   992         var_data%units = 'kg m-2 s-1'

   993         var_data%out_varname = 'evspsblsoi'

   994       ! evspsblveg

   995       case ('QVEGE')

   996         ! QVEGE: mm s-1 -> kg m-2 s-1

   997         sfactor = 1.0

   998         var_data%units = 'kg m-2 s-1'

   999         var_data%out_varname = 'evspsblveg'

  1000       ! mrfsl (multi-level)

  1001       case ('SOILICE')

  1002         ! SOILICE: kg m-2 -> kg m-2

  1003         sfactor = 1.0

  1004         var_data%units = 'kg m-2'

  1005         var_data%out_varname = 'mrfsl'

  1006       ! mrfso

  1007       case ('TOTAL_SOILICE')

  1008         ! TOTAL_SOILICE: kg m-2 -> kg m-2

  1009         sfactor = 1.0

  1010         var_data%units = 'kg m-2'

  1011         var_data%out_varname = 'mrfso'

  1012       ! mrlsl (multi-level)

  1013       case ('SOILLIQ')

  1014         ! SOILLIQ: kg m-2 -> kg m-2

  1015         sfactor = 1.0

  1016         var_data%units = 'kg m-2'

  1017         var_data%out_varname = 'mrlsl'

  1018       ! mrlso

  1019       case ('TOTAL_SOILLIQ')

  1020         ! TOTAL_SOILLIQ: kg m-2 -> kg m-2

  1021         sfactor = 1.0

  1022         var_data%units = 'kg m-2'

  1023         var_data%out_varname = 'mrlso'

  1024       ! mrros

  1025       case ('QOVER')

  1026         ! QOVER: mm s-1 -> kg m-2 s-1

  1027         sfactor = 1.0

  1028         var_data%units = 'kg m-2 s-1'

  1029         var_data%out_varname = 'mrros'

  1030       ! mrross

  1031       case ('QDRAI')

  1032         ! QDRAI: mm s-1 -> kg m-2 s-1

  1033         sfactor = 1.0

  1034         var_data%units = 'kg m-2 s-1'

  1035         var_data%out_varname = 'mrross'

  1036       ! prveg

  1037       case ('QINTR')

  1038         ! QINTR: mm s-1 -> kg m-2 s-1

  1039         sfactor = 1.0

  1040         var_data%units = 'kg m-2 s-1'

  1041         var_data%out_varname = 'prveg'

  1042       ! snd

  1043       case ('H2OSNO')

  1044         ! H2OSNO: mm -> m

  1045         sfactor = 1.0e-3

  1046         var_data%units = 'm'

  1047         var_data%out_varname = 'snd'

  1048       ! tran

  1049       case ('QVEGT')

  1050         ! QVEGT: mm s-1 -> kg m-2 s-1

  1051         sfactor = 1.0

  1052         var_data%units = 'kg m-2 s-1'

  1053         var_data%out_varname = 'tran'

  1054       ! vfwsl (multi-level)

  1055       case ('H2OSOI')

  1056         ! H2OSOI: mm3 mm-3 -> m3 m-3

  1057         sfactor = 1.0

  1058         var_data%units = 'm3 m-3'

  1059         var_data%out_varname = 'vfwsl'

  1060       ! wpsl (multi-level)

  1061       case ('SOILPSI')

  1062         ! SOILPSI: Pa -> Pa

  1063         sfactor = 1.0

  1064         var_data%units = 'Pa'

  1065         var_data%out_varname = 'wpsl'

  1067       !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  1068       ! Radiation

  1069       !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  1070       ! alsas

  1071       case ('ALL_SKY_ALBEDO')

  1072         ! ALL_SKY_ALBEDO: 1 -> 1

  1073         sfactor = 1.0

  1074         var_data%units = '1'

  1075         var_data%out_varname = 'alsas'

  1076       ! alsbs

  1077       case ('BLACK_SKY_ALBEDO')

  1078         ! BLACK_SKY_ALBEDO: 1 -> 1

  1079         sfactor = 1.0

  1080         var_data%units = '1'

  1081         var_data%out_varname = 'alsbs'

  1082       ! laisha

  1083       case ('LAISHA')

  1084         ! LAISHA: m2 m-2 -> m2 m-2

  1085         sfactor = 1.0

  1086         var_data%units = 'm2 m-2'

  1087         var_data%out_varname = 'laisha'

  1088       ! laisun

  1089       case ('LAISUN')

  1090         ! LAISUN: m2 m-2 -> m2 m-2

  1091         sfactor = 1.0

  1092         var_data%units = 'm2 m-2'

  1093         var_data%out_varname = 'laisun'

  1094       ! rlds

  1095       case ('FLDS')

  1096         ! FLDS: W m-2 -> W m-2

  1097         sfactor = 1.0

  1098         var_data%units = 'W m-2'

  1099         var_data%positive = 'down'

  1100         var_data%out_varname = 'rlds'

  1101       ! rls

  1102       case ('FIRA')

  1103         ! FIRA: W m-2 -> W m-2

  1104         sfactor = 1.0

  1105         var_data%units = 'W m-2'

  1106         var_data%positive = 'down'

  1107         var_data%out_varname = 'rls'

  1108       ! rlus

  1109       case ('FIRE')

  1110         ! FIRE: W m-2 -> W m-2

  1111         sfactor = 1.0

  1112         var_data%units = 'W m-2'

  1113         var_data%positive = 'up'

  1114         var_data%out_varname = 'rlus'

  1115       ! rs

  1116       case ('NETRAD')

  1117         ! NETRAD: W m-2 -> W m-2

  1118         sfactor = 1.0

  1119         var_data%units = 'W m-2'

  1120         var_data%positive = 'down'

  1121         var_data%out_varname = 'rs'

  1122       ! rsas

  1123       case ('FSA')

  1124         ! FSA: W m-2 -> W m-2

  1125         sfactor = 1.0

  1126         var_data%units = 'W m-2'

  1127         var_data%positive = 'down'

  1128         var_data%out_varname = 'rsas'

  1129       ! rsasg

  1130       case ('SABG')

  1131         ! SABG: W m-2 -> W m-2

  1132         sfactor = 1.0

  1133         var_data%units = 'W m-2'

  1134         var_data%positive = 'down'

  1135         var_data%out_varname = 'rsasg'

  1136       ! rsasv

  1137       case ('SABV')

  1138         ! SABV: W m-2 -> W m-2

  1139         sfactor = 1.0

  1140         var_data%units = 'W m-2'

  1141         var_data%positive = 'down'

  1142         var_data%out_varname = 'rsasv'

  1143       ! rsds

  1144       case ('FSDS')

  1145         ! FSDS: W m-2 -> W m-2

  1146         sfactor = 1.0

  1147         var_data%units = 'W m-2'

  1148         var_data%positive = 'down'

  1149         var_data%out_varname = 'rsds'

  1150       ! rsus

  1151       case ('FSR')

  1152         ! FSR: W m-2 -> W m-2

  1153         sfactor = 1.0

  1154         var_data%units = 'W m-2'

  1155         var_data%positive = 'up'

  1156         var_data%out_varname = 'rsus'

  1157       ! snc

  1158       case ('FSNO')

  1159         ! FSNO: 1 -> 1

  1160         sfactor = 1.0

  1161         var_data%units = '1'

  1162         var_data%out_varname = 'snc'

  1164       !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  1165       ! Temperature

  1166       !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  1167       ! degday

  1168       case ('DEGDAY')

  1169         ! DEGDAY: C -> K

  1170         sfactor = 1.0

  1171         offset  = 273.15

  1172         var_data%units = 'K'

  1173         var_data%out_varname = 'degday'

  1174       ! ta2m

  1175       case ('TSA')

  1176         ! TSA: K -> K

  1177         sfactor = 1.0

  1178         var_data%units = 'K'

  1179         var_data%out_varname = 'ta2m'

  1180       ! ta2mdmax

  1181       case ('TREFMXAV')

  1182         ! TREFMXAV: K -> K

  1183         sfactor = 1.0

  1184         var_data%units = 'K'

  1185         var_data%out_varname = 'ta2mdmax'

  1186       ! ta2mdmin

  1187       case ('TREFMNAV')

  1188         ! TREFMNAV: K -> K

  1189         sfactor = 1.0

  1190         var_data%units = 'K'

  1191         var_data%out_varname = 'ta2mdmin'

  1192       ! tsl (multi-level)

  1193       case ('TSOI')

  1194         ! TSOI: K -> K

  1195         sfactor = 1.0

  1196         var_data%units = 'K'

  1197         var_data%out_varname = 'tsl'

  1198       ! tv

  1199       case ('TV')

  1200         ! TV: K -> K

  1201         sfactor = 1.0

  1202         var_data%units = 'K'

  1203         var_data%out_varname = 'tv'

  1205       !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  1206       ! Vegetation phenology

  1207       !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  1208       ! laiexp

  1209       case ('ELAI')

  1210         ! ELAI: m2 m-2 -> m2 m-2

  1211         sfactor = 1.0

  1212         var_data%units = 'm2 m-2'

  1213         var_data%out_varname = 'laiexp'

  1214       ! laitot

  1215       case ('TLAI')

  1216         ! TLAI: m2 m-2 -> m2 m-2

  1217         sfactor = 1.0

  1218         var_data%units = 'm2 m-2'

  1219         var_data%out_varname = 'laitot'

  1220       ! saiexp

  1221       case ('ESAI')

  1222         ! ESAI: m2 m-2 -> m2 m-2

  1223         sfactor = 1.0

  1224         var_data%units = 'm2 m-2'

  1225         var_data%out_varname = 'saiexp'

  1226       ! saitot

  1227       case ('TSAI')

  1228         ! TSAI: m2 m-2 -> m2 m-2

  1229         sfactor = 1.0

  1230         var_data%units = 'm2 m-2'

  1231         var_data%out_varname = 'saitot'

  1233       !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  1234       ! Vegetation physiology

  1235       !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!

  1236       ! psn

  1237       case ('FPSN')

  1238         ! FPSN: umol m-2 s-1 -> kg m-2 s-1

  1239         sfactor = 12.0 * 1.0e-6 * 1.0e-3

  1240         var_data%units = 'kg m-2 s-1'

  1241         var_data%out_varname = 'psn'

  1242       ! rssha

  1243       case ('RSSHA')

  1244         ! RSSHA: s m-1 -> s m-1

  1245         sfactor = 1.0

  1246         var_data%units = 's m-1'

  1247         var_data%out_varname = 'rssha'

  1248       ! rssun

  1249       case ('RSSUN')

  1250         ! RSSUN: s m-1 -> s m-1

  1251         sfactor = 1.0

  1252         var_data%units = 's m-1'

  1253         var_data%out_varname = 'rssun'

  1255       case default

  1256         print *, 'clm_convert_data: Unknown variable name ', var_data%varname

  1257         stop

  1258     end select

  1260     ! Convert to the desired units using the offset and scale factor (sfactor)

  1261     select case (var_data%ndims)

  1262       case (2)

  1263         allocate(mask2d(coord%xsize, coord%ysize), stat=ierr)

  1264         if (ierr /= 0) then

  1265           print *, 'clm_convert_data: Cannot allocate 2d mask'

  1266           stop

  1267         end if

  1268         mask2d = .false.

  1269         if (var_data%int_type) then

  1270           where (var_data%int2d /= var_data%missing_value)

  1271             var_data%int2d = int(var_data%int2d * sfactor + offset)

  1272             mask2d = .true.

  1273           end where

  1274           print *, var_data%out_varname, &

  1275             ' min:', minval(var_data%int2d, mask=mask2d), &

  1276             ' max:', maxval(var_data%int2d, mask=mask2d)

  1277         else

  1278           where (var_data%var2d /= var_data%missing_value)

  1279             var_data%var2d = var_data%var2d * sfactor + offset

  1280             mask2d = .true.

  1281           end where

  1282           print *, var_data%out_varname, &

  1283             ' min:', minval(var_data%var2d, mask=mask2d), &

  1284             ' max:', maxval(var_data%var2d, mask=mask2d)

  1285         end if

  1286         if (allocated(mask2d)) deallocate(mask2d)

  1287       case (3)

  1288         allocate(mask3d(coord%xsize, coord%ysize, coord%tsize), stat=ierr)

  1289         if (ierr /= 0) then

  1290           print *, 'clm_convert_data: Cannot allocate 3d mask'

  1291           stop

  1292         end if

  1293         mask3d = .false.

  1294         where (var_data%var3d /= var_data%missing_value)

  1295            var_data%var3d = (var_data%var3d + offset) * sfactor

  1296            mask3d = .true.

  1297         end where

  1298         print *, var_data%out_varname, &

  1299           ' min:', minval(var_data%var3d, mask=mask3d), &

  1300           ' max:', maxval(var_data%var3d, mask=mask3d)

  1301         if (allocated(mask3d)) deallocate(mask3d)

  1302       case (4)

  1303         if (var_data%soil_layer_flag) then

  1304           allocate(mask4d(coord%xsize, coord%ysize, coord%zsoi_size, coord%tsize), stat=ierr)

  1305           if (ierr /= 0) then

  1306             print *, 'clm_convert_data: Cannot allocate 4d mask'

  1307             stop

  1308           end if

  1309           mask4d = .false.

  1310           where (var_data%var4d /= var_data%missing_value)

  1311              var_data%var4d = (var_data%var4d + offset) * sfactor

  1312              mask4d = .true.

  1313           end where

  1314           print *, var_data%out_varname, &

  1315             ' min:', minval(var_data%var4d, mask=mask4d), &

  1316             ' max:', maxval(var_data%var4d, mask=mask4d)

  1317           if (allocated(mask4d)) deallocate(mask4d)

  1318         else

  1319           print *,'clm_convert_data: Unknown data dimension'

  1320           stop

  1321         end if

  1322       case default

  1323         print *,'clm_convert_data: Dimension count not supported'

  1324         stop

  1325     end select

  1327     end subroutine clm_convert_data

  1328     !

  1329     !--------------------------------------------------------------------------

  1330     !

  1331     subroutine clm_free_data

  1333     implicit none

  1335     var_data%varname = ''

  1336     var_data%ndims = 0

  1337     if (allocated(var_data%int2d))        deallocate(var_data%int2d)

  1338     if (allocated(var_data%var2d))        deallocate(var_data%var2d)

  1339     if (allocated(var_data%var3d))        deallocate(var_data%var3d)

  1340     if (allocated(var_data%var4d))        deallocate(var_data%var4d)

  1341     if (allocated(var_data%time))         deallocate(var_data%time)

  1342     if (allocated(var_data%time_bounds))  deallocate(var_data%time_bounds)

  1343     var_data%int_type        = .false.

  1344     var_data%soil_layer_flag = .false.

  1345     var_data%hour_flag       = .false.

  1346     var_data%long_name       = ''

  1347     var_data%missing_value   = 0.

  1348     var_data%units           = ''

  1349     var_data%positive        = ''

  1350     var_data%out_varname     = ''

  1352     end subroutine clm_free_data

  1353     !

  1354     !--------------------------------------------------------------------------

  1355     !

  1356     subroutine nc_err(status)

  1358     implicit none

  1359     integer :: status ! status code

  1361     if (status /= nf90_noerr) then

  1362        print *, nf90_strerror(status)

  1363        stop 'Program stopped after encountering netCDF error.'

  1364     end if

  1366     end subroutine nc_err

  1367     !

  1368     !--------------------------------------------------------------------------

  1369     !

  1371 end module clm_mod

author	Forrest Hoffman <forrest@climatemodeling.org>
	Sun, 21 Sep 2008 21:59:01 -0400
changeset 0	c8ca04c3a9d6
child 1	2bbb71ef2f67
permissions	-rw-r--r--