cable_read.F90 Source File


This file depends on

sourcefile~~cable_read.f90~~EfferentGraph sourcefile~cable_read.f90 cable_read.F90 sourcefile~cable_abort.f90 cable_abort.F90 sourcefile~cable_read.f90->sourcefile~cable_abort.f90 sourcefile~cable_define_types.f90 cable_define_types.F90 sourcefile~cable_read.f90->sourcefile~cable_define_types.f90 sourcefile~cable_iovars.f90 cable_iovars.F90 sourcefile~cable_read.f90->sourcefile~cable_iovars.f90 sourcefile~cable_abort.f90->sourcefile~cable_define_types.f90 sourcefile~cable_abort.f90->sourcefile~cable_iovars.f90 sourcefile~cable_climate_type_mod.f90 cable_climate_type_mod.F90 sourcefile~cable_define_types.f90->sourcefile~cable_climate_type_mod.f90 sourcefile~cable_iovars.f90->sourcefile~cable_define_types.f90 sourcefile~cable_common.f90 cable_common.F90 sourcefile~cable_climate_type_mod.f90->sourcefile~cable_common.f90 sourcefile~grid_constants_cbl.f90 grid_constants_cbl.F90 sourcefile~cable_climate_type_mod.f90->sourcefile~grid_constants_cbl.f90 sourcefile~cable_runtime_opts_mod.f90 cable_runtime_opts_mod.F90 sourcefile~cable_common.f90->sourcefile~cable_runtime_opts_mod.f90

Files dependent on this one

sourcefile~~cable_read.f90~~AfferentGraph sourcefile~cable_read.f90 cable_read.F90 sourcefile~cable_initialise.f90 cable_initialise.F90 sourcefile~cable_initialise.f90->sourcefile~cable_read.f90 sourcefile~cable_input.f90 cable_input.F90 sourcefile~cable_input.f90->sourcefile~cable_read.f90 sourcefile~cable_input.f90->sourcefile~cable_initialise.f90 sourcefile~cable_driver_common.f90 cable_driver_common.F90 sourcefile~cable_driver_common.f90->sourcefile~cable_input.f90 sourcefile~cable_mpimaster.f90 cable_mpimaster.F90 sourcefile~cable_mpimaster.f90->sourcefile~cable_input.f90 sourcefile~cable_mpimaster.f90->sourcefile~cable_driver_common.f90 sourcefile~cable_mpiworker.f90 cable_mpiworker.F90 sourcefile~cable_mpiworker.f90->sourcefile~cable_input.f90 sourcefile~cable_mpiworker.f90->sourcefile~cable_driver_common.f90 sourcefile~cable_serial.f90 cable_serial.F90 sourcefile~cable_serial.f90->sourcefile~cable_input.f90 sourcefile~cable_serial.f90->sourcefile~cable_driver_common.f90 sourcefile~cable_offline_driver.f90 cable_offline_driver.F90 sourcefile~cable_offline_driver.f90->sourcefile~cable_driver_common.f90 sourcefile~cable_offline_driver.f90->sourcefile~cable_serial.f90

Source Code

!==============================================================================
! This source code is part of the
! Australian Community Atmosphere Biosphere Land Exchange (CABLE) model.
! This work is licensed under the CSIRO Open Source Software License
! Agreement (variation of the BSD / MIT License).
!
! You may not use this file except in compliance with this License.
! A copy of the License (CSIRO_BSD_MIT_License_v2.0_CABLE.txt) is located
! in each directory containing CABLE code.
!
! ==============================================================================
! Purpose: Read routines for CABLE offline
!
! Contact: Bernard.Pak@csiro.au
!
! History: New routines (redistr*) to do land use change
!
!
! ==============================================================================
! CALLed from:    cable_serial.f90
! MODULEs used:   cable_abort_module
!                 cable_IO_vars_module
!                 netcdf
!
! CALLs:          readpar_i
!                 readpar_r
!                 readpar_rd
!                 readpar_r2
!                 readpar_r2d
!                 nc_abort
!                 redistr*
!
MODULE cable_read_module


  USE cable_abort_module
  USE cable_def_types_mod, ONLY : ms, ncp, r_2, mland, mp, ncs, nrb, msn
  USE cable_IO_vars_module, ONLY: landpt, exists, land_x, land_y, metGrid
  USE netcdf

  IMPLICIT NONE
  PRIVATE
  PUBLIC readpar, redistr_i, redistr_r, redistr_rd, redistr_r2, redistr_r2d

  INTEGER :: ok ! netcdf error status
  INTERFACE readpar
     ! Loads a parameter from the met file - chooses subroutine
     ! below depending on number/type/dimension of arguments
     MODULE PROCEDURE readpar_i   ! for integer parameter read
     MODULE PROCEDURE readpar_r   ! for real parameter read
     MODULE PROCEDURE readpar_rd  ! for double precision real parameter read
     MODULE PROCEDURE readpar_r2  ! for 2d real parameter read
     MODULE PROCEDURE readpar_r2d ! for double precision 2d real parameter read
  END INTERFACE
  ! INTERFACE redistr
  !   MODULE PROCEDURE redistr_i
  !   MODULE PROCEDURE redistr_r
  !   MODULE PROCEDURE redistr_rd
  !   MODULE PROCEDURE redistr_r2
  !   MODULE PROCEDURE redistr_r2d
  ! END INTERFACE

CONTAINS

  SUBROUTINE readpar_i(ncid, parname, completeSet, var_i, filename,            &
       npatch, dimswitch, from_restart, INpatch)
    ! Subroutine for loading an integer-valued parameter
    INTEGER, INTENT(IN) :: ncid ! netcdf file ID
    INTEGER, INTENT(IN) :: npatch ! # of veg patches in parameter's file
    INTEGER, INTENT(IN),OPTIONAL :: INpatch
    INTEGER, DIMENSION(:), INTENT(INOUT) :: var_i ! returned parameter
    ! values
    LOGICAL, INTENT(IN),OPTIONAL :: from_restart ! reading from restart file?
    LOGICAL, INTENT(INOUT) :: completeSet ! has every parameter been loaded?
    CHARACTER(LEN=*), INTENT(IN) :: parname ! name of parameter
    CHARACTER(LEN=*), INTENT(IN) :: filename ! file containing parameter values
    CHARACTER(LEN=*), INTENT(IN) :: dimswitch ! indicates dimension of
    ! parameter

    INTEGER :: parID ! parameter's netcdf ID
    INTEGER :: pardims ! # dimensions of parameter
    INTEGER :: i ! do loop counter
    INTEGER, DIMENSION(1) :: data1i ! temporary for ncdf read in
    INTEGER, DIMENSION(1, 1) :: data2i ! temporary for ncdf read in
    INTEGER, DIMENSION(:, :), POINTER :: tmp2i ! temporary for ncdf read in
    INTEGER, DIMENSION(:, :, :), POINTER :: tmp3i ! temporary for ncdf read
    ! in

    ! Check if parameter exists:
    ok = NF90_INQ_VARID(ncid,parname, parID)
    IF(ok /= NF90_NOERR) THEN ! if it doesn't exist
       completeSet=.FALSE.
       ! If this routine is reading from the restart, abort
       IF(PRESENT(from_restart))  WRITE(*,*) ' Error reading '//parname//' in file ' &
            //TRIM(filename)//' (SUBROUTINE readpar_i)'
    ELSE
       exists%parameters = .TRUE. ! Note that pars were found in file
       ! Check for grid type - restart file uses land type grid
       IF(metGrid == 'land' .OR. PRESENT(from_restart)) THEN
          ! Collect data from land only grid in netcdf file.
          ! First, check whether parameter has patch dimension:
          ok = NF90_INQUIRE_VARIABLE(ncid, parID, ndims=pardims)
          IF(pardims == 1) THEN ! no patch dimension, just a single land
             ! dimension
             IF(PRESENT(from_restart)) THEN
                ok = NF90_GET_VAR(ncid, parID, var_i, start=(/1/),             &
                     count=(/INpatch/))
                IF(ok /= NF90_NOERR) CALL nc_abort                             &
                     (ok,'Error reading '//parname//' in file ' &
                     //TRIM(filename)//' (SUBROUTINE readpar_i)')
             ELSE
                DO i = 1, mland ! over all land points/grid cells
                   ok = NF90_GET_VAR(ncid, parID, data1i, start=(/i/),         &
                        count=(/1/))
                   IF(ok /= NF90_NOERR) CALL nc_abort                          &
                        (ok, 'Error reading '//parname//' in file ' &
                        //TRIM(filename)//' (SUBROUTINE readpar_i)')
                   ! Write non-patch-specific value to all patches:
                   var_i(landpt(i)%cstart:landpt(i)%cend) = data1i(1)
                END DO
             END IF
          ELSE IF(pardims == 2) THEN ! i.e. parameter has a patch dimension
             ALLOCATE(tmp2i(1, npatch))
             DO i = 1, mland ! over all land points/grid cells
                ok = NF90_GET_VAR(ncid, parID, tmp2i,                          &
                     start=(/i,1/), count=(/1,npatch/))
                IF(ok /= NF90_NOERR) CALL nc_abort                             &
                     (ok, 'Error reading '//parname//' in met data file ' &
                     //TRIM(filename)//' (SUBROUTINE readpar_i)')
                ! Set values for this par for the # patches that exist
                var_i(landpt(i)%cstart:(landpt(i)%cstart + npatch - 1)) =      &
                     tmp2i(1, :)
             END DO
             DEALLOCATE(tmp2i)
          ELSE
             CALL abort('Dimension of '//parname//' parameter in '//           &
                  TRIM(filename)//' unknown.')
          END IF
       ELSE IF(metGrid == 'mask') THEN ! Get data from land/sea mask type grid:
          ! First, check whether parameter has patch dimension:
          ok = NF90_INQUIRE_VARIABLE(ncid, parID, ndims=pardims)
          IF(pardims == 2) THEN ! i.e. no patch dimension, just x-y grid
             ! dimensions
             DO i = 1, mland ! over all land points/grid cells
                ok = NF90_GET_VAR(ncid, parID, data2i,                         &
                     start=(/land_x(i),land_y(i)/), count=(/1,1/))
                IF(ok /= NF90_NOERR) CALL nc_abort                             &
                     (ok, 'Error reading '//parname//' in file ' &
                     //TRIM(filename)//' (SUBROUTINE readpar_i)')
                ! Set all patches to have the same value for this par:
                var_i(landpt(i)%cstart:landpt(i)%cend) = data2i(1, 1)
             END DO
          ELSE IF(pardims == 3) THEN ! i.e. parameter has a patch dimension
             ALLOCATE(tmp3i(1, 1, npatch))
             DO i = 1, mland ! over all land points/grid cells
                ok = NF90_GET_VAR(ncid, parID, tmp3i,                          &
                     start=(/land_x(i), land_y(i), 1/),           &
                     count=(/1, 1, npatch/))
                IF(ok /= NF90_NOERR) CALL nc_abort                             &
                     (ok,'Error reading '//parname//' in file '                &
                     //TRIM(filename)//' (SUBROUTINE readpar_i)')
                ! Set values for this par for the # patches that exist
                var_i(landpt(i)%cstart:(landpt(i)%cstart + npatch - 1)) =      &
                     tmp3i(1, 1, :)
             END DO
             DEALLOCATE(tmp3i)
          ELSE
             CALL abort('Dimension of '//parname//' parameter in met file '//  &
                  'unknown.')
          END IF
       END IF ! gridtype land or mask
    END IF ! parameter's existence

  END SUBROUTINE readpar_i
  !=============================================================================
  SUBROUTINE readpar_r(ncid, parname, completeSet, var_r, filename,            &
       npatch, dimswitch, from_restart, INpatch)
    ! Subroutine for loading a real-valued parameter
    INTEGER, INTENT(IN) :: ncid ! netcdf file ID
    INTEGER, INTENT(IN) :: npatch ! # of veg patches in parameter's file
    INTEGER, INTENT(IN), OPTIONAL :: INpatch
    REAL(KIND=4), DIMENSION(:), INTENT(INOUT) :: var_r ! returned parameter
    ! values
    LOGICAL, INTENT(IN), OPTIONAL :: from_restart ! reading from restart file?
    LOGICAL, INTENT(INOUT) :: completeSet ! has every parameter been loaded?
    CHARACTER(LEN=*), INTENT(IN) :: parname ! name of parameter
    CHARACTER(LEN=*), INTENT(IN) :: filename ! file containing parameter values
    CHARACTER(LEN=*), INTENT(IN) :: dimswitch ! indicates dimesnion of parameter

    INTEGER :: parID ! parameter's netcdf ID
    INTEGER :: pardims ! # dimensions of parameter
    INTEGER :: i ! do loop counter
    REAL(KIND=4), DIMENSION(1) :: data1r ! temporary for ncdf read in
    REAL(KIND=4), DIMENSION(1, 1) :: data2r ! temporary for ncdf read in
    REAL(KIND=4), DIMENSION(:, :), POINTER :: tmp2r ! temporary for ncdf read in
    REAL(KIND=4), DIMENSION(:, :, :), POINTER :: tmp3r ! temporary for ncdf read
    ! in

    ! Check if parameter exists:
    ok = NF90_INQ_VARID(ncid, parname, parID)
    IF(ok /= NF90_NOERR) THEN ! if it doesn't exist
       completeSet = .FALSE.
       ! If this routine is reading from the restart, abort
       IF(PRESENT(from_restart)) CALL nc_abort(ok,'Error reading '//parname//  &
            ' in file '//TRIM(filename)// '(SUBROUTINE readpar_r)')
    ELSE
       exists%parameters = .TRUE. ! Note that pars were found in file
       ! If block to distinguish params with non-spatial dimensions:
       IF(dimswitch == 'def') THEN ! i.e. parameters with one spatial dim
          ! of length mland*maxpatches
          ! Check for grid type - restart file uses land type grid
          IF(metGrid == 'land' .OR. PRESENT(from_restart)) THEN
             ! Collect data from land only grid in netcdf file.
             ! First, check whether parameter has patch dimension:
             ok = NF90_INQUIRE_VARIABLE(ncid, parID, ndims=pardims)
             IF(pardims == 1) THEN ! no patch dimension, just a single land
                ! dimension
                IF(PRESENT(from_restart)) THEN
                   ok = NF90_GET_VAR(ncid, parID, var_r, start=(/1/),          &
                        count=(/INpatch/))
                   IF(ok /= NF90_NOERR) CALL nc_abort                          &
                        (ok,'Error reading '//parname//' in file ' &
                        //TRIM(filename)//' (SUBROUTINE readpar_r)')
                ELSE
                   DO i = 1, mland ! over all land points/grid cells
                      ok = NF90_GET_VAR(ncid, parID, data1r, start=(/i/),      &
                           count=(/1/))
                      IF(ok /= NF90_NOERR) CALL nc_abort                       &
                           (ok,'Error reading '//parname//' in file ' &
                           //TRIM(filename)//' (SUBROUTINE readpar_r)')
                      ! All patches set to the same value if no patch info:
                      var_r(landpt(i)%cstart:landpt(i)%cend) = data1r(1)
                   END DO
                END IF
             ELSE IF(pardims == 2) THEN ! i.e. parameter has a patch dimension
                ALLOCATE(tmp2r(1, npatch))
                DO i = 1, mland ! over all land points/grid cells
                   ok = NF90_GET_VAR(ncid, parID, tmp2r,                       &
                        start=(/i, 1/), count=(/1, npatch/))
                   IF(ok /= NF90_NOERR) CALL nc_abort                          &
                        (ok,'Error reading '//parname//' in file ' &
                        //TRIM(filename)//' (SUBROUTINE readpar_r)')
                   ! Set values for this par for the # patches that exist
                   var_r(landpt(i)%cstart:(landpt(i)%cstart + npatch - 1)) =   &
                        tmp2r(1, :)
                END DO
                DEALLOCATE(tmp2r)
             ELSE
                CALL abort('Dimension of '//parname//                          &
                     ' parameter in met file unknown.')
             END IF
          ELSE IF(metGrid == 'mask') THEN ! Get data from land/sea mask type
             ! grid:
             ! First, check whether parameter has patch dimension:
             ok = NF90_INQUIRE_VARIABLE(ncid, parID, ndims=pardims)
             IF(pardims == 2) THEN ! no patch dimension, just x-y grid
                ! dimensions
                DO i = 1, mland ! over all land points/grid cells
                   ok = NF90_GET_VAR(ncid, parID, data2r,                      &
                        start=(/land_x(i),land_y(i)/), count=(/1, 1/))
                   IF(ok /= NF90_NOERR) CALL nc_abort                          &
                        (ok,'Error reading '//parname//' in file ' &
                        //TRIM(filename)//' (SUBROUTINE readpar_r)')
                   ! Set all patches to have the same value for this par:
                   var_r(landpt(i)%cstart:landpt(i)%cend) = data2r(1, 1)
                END DO
             ELSE IF(pardims == 3) THEN ! i.e. parameter has a patch dimension
                ALLOCATE(tmp3r(1, 1, npatch))
                DO i = 1, mland ! over all land points/grid cells
                   ok = NF90_GET_VAR(ncid, parID, tmp3r,                       &
                        start=(/land_x(i), land_y(i), 1/),        &
                        count=(/1, 1, npatch/))
                   IF(ok /= NF90_NOERR) CALL nc_abort                          &
                        (ok,'Error reading '//parname//' in file ' &
                        //TRIM(filename)//' (SUBROUTINE readpar_r)')
                   ! Set values for this par for the # patches that exist
                   var_r(landpt(i)%cstart:(landpt(i)%cstart + npatch - 1)) =   &
                        tmp3r(1, 1, :)
                END DO
                DEALLOCATE(tmp3r)
             ELSE
                CALL abort('Dimension of '//parname//                          &
                     ' parameter in met file unknown.')
             END IF
          END IF ! gridtype land or mask
       ELSE IF(dimswitch == 'ms') THEN ! ie par has only soil dimension, no
          ! spatial
          ! Load parameter values (e.g. zse):
          ok = NF90_GET_VAR(ncid, parID, var_r, start=(/1/), count=(/ms/))
          IF(ok /= NF90_NOERR) CALL nc_abort                                   &
               (ok,'Error reading '//parname//' in file ' &
               //TRIM(filename)//' (SUBROUTINE readpar_r)')
       ELSE IF(dimswitch == 'ncp') THEN ! ie par has only ncp dimension e.g.
          ! ratecp
          ! Load ratecp parameter values:
          ok = NF90_GET_VAR(ncid, parID, var_r, start=(/1/), count=(/ncp/))
          IF(ok /= NF90_NOERR) CALL nc_abort                                   &
               (ok, 'Error reading '//parname//' in file ' &
               //TRIM(filename)//' (SUBROUTINE readpar_r)')
       ELSE IF(dimswitch == 'ncs') THEN ! ie par has only ncs dimension e.g.
          ! ratecs
          ! Load parameter values:
          ok = NF90_GET_VAR(ncid, parID, var_r, start=(/1/), count=(/ncs/))
          IF(ok /= NF90_NOERR) CALL nc_abort                                   &
               (ok,'Error reading '//parname//' in file ' &
               //TRIM(filename)//' (SUBROUTINE readpar_r)')
       ELSE
          CALL abort('Parameter or initial state '//parname//                  &
               ' called with unknown dimension switch - '//dimswitch//   &
               ' - in INTERFACE readpar')
       END IF ! dimension of parameter i.e. is this zse or ratecp or ratecs
    END IF ! parameter's existence

  END SUBROUTINE readpar_r
  !=============================================================================
  SUBROUTINE readpar_rd(ncid, parname, completeSet, var_rd, filename,          &
       npatch, dimswitch, from_restart, INpatch)
    ! Subroutine for loading a double precision real-valued parameter
    INTEGER, INTENT(IN) :: ncid ! netcdf file ID
    INTEGER, INTENT(IN) :: npatch ! # of veg patches in parameter's file
    REAL(r_2), DIMENSION(:), INTENT(INOUT) :: var_rd ! returned parameter
    ! values
    LOGICAL, INTENT(IN), OPTIONAL :: from_restart ! reading from restart file?
    LOGICAL, INTENT(INOUT) :: completeSet ! has every parameter been loaded?
    CHARACTER(LEN=*), INTENT(IN) :: parname ! name of parameter
    CHARACTER(LEN=*), INTENT(IN) :: filename ! file containing parameter values
    CHARACTER(LEN=*), INTENT(IN) :: dimswitch ! indicates dimesnion of
    ! parameter
    INTEGER, INTENT(IN),OPTIONAL :: INpatch
    INTEGER :: parID ! parameter's netcdf ID
    INTEGER :: pardims ! # dimensions of parameter
    INTEGER :: i ! do loop counter
    REAL(4), DIMENSION(1) :: data1r ! temporary for ncdf read in
    REAL(4), DIMENSION(1, 1) :: data2r ! temporary for ncdf read in
    REAL(4), DIMENSION(:), POINTER :: tmp1r ! temporary for ncdf read in
    REAL(4), DIMENSION(:, :), POINTER :: tmp2r ! temporary for ncdf read in
    REAL(4), DIMENSION(:, :, :), POINTER :: tmp3r ! temporary for ncdf read in

    ! Check if parameter exists:
    ok = NF90_INQ_VARID(ncid, parname, parID)
    IF(ok /= NF90_NOERR) THEN ! if it doesn't exist
       completeSet = .FALSE.
       ! If this routine is reading from the restart, abort
       IF(PRESENT(from_restart)) CALL nc_abort(ok,'Error reading '//parname//  &
            ' in file '//TRIM(filename)// '(SUBROUTINE readpar_rd)')
    ELSE
       exists%parameters = .TRUE. ! Note that pars were found in file
       ! If block to distinguish params with non-spatial dimensions:
       IF(dimswitch(1:3) == 'def') THEN ! i.e. parameters with one spatial dim
          ! of length mland*maxpatches
          ! Check for grid type - restart file uses land type grid
          IF(metGrid == 'land' .OR. PRESENT(from_restart)) THEN
             ! Collect data from land only grid in netcdf file.
             ! First, check whether parameter has patch dimension:
             ok = NF90_INQUIRE_VARIABLE(ncid, parID, ndims=pardims)
             IF(pardims == 1) THEN ! no patch dimension, just a single land
                ! dimension
                IF(PRESENT(from_restart)) THEN
                   !                   IF(dimswitch(1:4) == 'defd') THEN ! ie we're expecting to
                   ! read double prec.
                   !                      ! Read double precision data:
                   !                      ok = NF90_GET_VAR(ncid,parID,var_rd,start=(/1/),        &
                   !                                        count=(/INpatch/))
                   !                   ELSE ! ie we're reading single prec. var in netdf file
                   ! Read single precision data:
                   ALLOCATE(tmp1r(INpatch))
                   ok = NF90_GET_VAR(ncid, parID, tmp1r, start=(/1/),       &
                        count=(/INpatch/))
                   var_rd = REAL(tmp1r, r_2)
                   DEALLOCATE(tmp1r)
                   !                   END IF
                   IF(ok /= NF90_NOERR) CALL nc_abort                       &
                        (ok,'Error reading '//parname//' in file ' &
                        //TRIM(filename)//' (SUBROUTINE readpar_rd)')
                ELSE ! reading from met file
                   DO i = 1, mland ! over all land points/grid cells
                      ok = NF90_GET_VAR(ncid, parID, data1r, start=(/i/),      &
                           count=(/1/))
                      IF(ok /= NF90_NOERR) CALL nc_abort                       &
                           (ok,'Error reading '//parname//' in file ' &
                           //TRIM(filename)//' (SUBROUTINE readpar_rd)')
                      ! Give single value to all patches if no patch specific
                      ! info:
                      var_rd(landpt(i)%cstart:landpt(i)%cend) =                &
                           REAL(data1r(1))
                   END DO
                END IF
             ELSE IF(pardims == 2) THEN ! i.e. parameter has a patch dimension
                ! NB restart file will not have a patch dimension, therefore
                ! all reads here are of single precision variables.
                ALLOCATE(tmp2r(1, npatch))
                DO i = 1, mland ! over all land points/grid cells
                   ok = NF90_GET_VAR(ncid, parID, tmp2r,                       &
                        start=(/i, 1/), count=(/1, npatch/))
                   IF(ok /= NF90_NOERR) CALL nc_abort                          &
                        (ok, 'Error reading '//parname//' in file ' &
                        //TRIM(filename)//' (SUBROUTINE readpar_rd)')
                   ! Set values for this par for the # patches that exist
                   var_rd(landpt(i)%cstart:(landpt(i)%cstart + npatch - 1)) =  &
                        REAL(tmp2r(1, :), r_2)
                END DO
                DEALLOCATE(tmp2r)
             ELSE
                CALL abort('Dimension of '//parname//                          &
                     ' parameter in met file unknown.')
             END IF
          ELSE IF(metGrid == 'mask') THEN ! Get data from land/sea mask type
             ! grid:
             ! NB restart file will not have mask grid, therefore all reads
             ! here are of single precision variables in the netcdf met file
             ! First, check whether parameter has patch dimension:
             ok = NF90_INQUIRE_VARIABLE(ncid, parID, ndims=pardims)
             IF(pardims == 2) THEN ! no patch dimension, just x-y grid
                ! dimensions
                DO i=1, mland ! over all land points/grid cells
                   ok= NF90_GET_VAR(ncid, parID, data2r,                       &
                        start=(/land_x(i), land_y(i)/),            &
                        count=(/1, 1/))
                   IF(ok /= NF90_NOERR) CALL nc_abort                          &
                        (ok, 'Error reading '//parname//' in file ' &
                        //TRIM(filename)//' (SUBROUTINE readpar_rd)')
                   ! Set all patches to have the same value for this par:
                   var_rd(landpt(i)%cstart:landpt(i)%cend) =                   &
                        REAL(data2r(1, 1), r_2)
                END DO
             ELSE IF(pardims == 3) THEN ! i.e. parameter has a patch dimension
                ALLOCATE(tmp3r(1, 1, npatch))
                DO i = 1, mland ! over all land points/grid cells
                   ok = NF90_GET_VAR(ncid, parID, tmp3r,                       &
                        start=(/land_x(i), land_y(i), 1/),        &
                        count=(/1, 1, npatch/))
                   IF(ok /= NF90_NOERR) CALL nc_abort                          &
                        (ok, 'Error reading '//parname//' in file ' &
                        //TRIM(filename)//' (SUBROUTINE readpar_rd)')
                   ! Set values for this par for the # patches that exist
                   var_rd(landpt(i)%cstart:(landpt(i)%cstart + npatch - 1))    &
                        = REAL(tmp3r(1, 1, :), r_2)
                END DO
                DEALLOCATE(tmp3r)
             ELSE
                CALL abort('Dimension of '//parname//                          &
                     ' parameter in met file unknown.')
             END IF
          ELSE
             CALL abort('Prescribed input grid '//metGrid//' unknown.')
          END IF ! gridtype land or mask

       ELSE IF(dimswitch(1:2) == 'ms') THEN ! ie par has only soil dimension,
          ! no spatial
          ! Load parameter values (e.g. zse):
          DO i = 1, ms
             ok = NF90_GET_VAR(ncid, parID, data1r, start=(/i/), count=(/1/))
             IF(ok /= NF90_NOERR) CALL nc_abort                                &
                  (ok, 'Error reading '//parname//' in file ' &
                  //TRIM(filename)//' (SUBROUTINE readpar_rd)')
             var_rd(i) = REAL(data1r(1), r_2)
          END DO
       ELSE IF(dimswitch(1:3) == 'ncp') THEN ! ie par has only ncp dimension
          ! e.g. ratecp
          ! Load ratecp parameter values:
          DO i = 1, ncp
             ok = NF90_GET_VAR(ncid, parID, data1r, start=(/i/), count=(/1/))
             IF(ok /= NF90_NOERR) CALL nc_abort                                &
                  (ok, 'Error reading '//parname//' in file ' &
                  //TRIM(filename)//' (SUBROUTINE readpar_rd)')
             var_rd(i) = REAL(data1r(1), r_2)
          END DO
       ELSE IF(dimswitch(1:3) == 'ncs') THEN ! ie par has only ncs dimension
          ! e.g. ratecs
          ! Load parameter values:
          DO i = 1, ncs
             ok = NF90_GET_VAR(ncid, parID, data1r, start=(/i/), count=(/1/))
             IF(ok /= NF90_NOERR) CALL nc_abort                                &
                  (ok,'Error reading '//parname//' in file ' &
                  //TRIM(filename)//' (SUBROUTINE readpar_rd)')
             var_rd(i) = REAL(data1r(1), r_2)
          END DO
       ELSE
          CALL abort('Parameter or initial state '//parname//                  &
               ' called with unknown dimension switch - '//dimswitch//   &
               ' - in INTERFACE readpar')
       END IF ! dimension of parameter i.e. is this zse or ratecp or ratecs
    END IF ! parameter's existence

  END SUBROUTINE readpar_rd
  !=============================================================================
  SUBROUTINE readpar_r2(ncid, parname, completeSet, var_r2, filename,          &
       npatch, dimswitch, from_restart, INpatch)
    ! Subroutine for loading a two dimensional real-valued parameter
    INTEGER, INTENT(IN) :: ncid ! netcdf file ID
    INTEGER, INTENT(IN) :: npatch ! number of veg patches in file
    INTEGER, INTENT(IN), OPTIONAL :: INpatch
    REAL(KIND=4), DIMENSION(:,:), INTENT(INOUT) :: var_r2 ! returned parameter
    ! values
    LOGICAL, INTENT(IN), OPTIONAL :: from_restart ! reading from restart file?
    LOGICAL, INTENT(INOUT) :: completeSet ! has every parameter been loaded?
    CHARACTER(LEN=*), INTENT(IN) :: filename ! file containing parameter values
    CHARACTER(LEN=*), INTENT(IN) :: dimswitch ! indicates dimesnion of
    ! parameter
    CHARACTER(LEN=*), INTENT(IN) :: parname ! name of parameter

    INTEGER :: parID ! parameter's netcdf ID
    INTEGER :: pardims ! # dimensions of parameter
    INTEGER :: dimctr ! size of non-spatial (2nd) dimension of parameter
    INTEGER :: i, j ! do loop counter
    REAL(KIND=4), DIMENSION(:, :), POINTER       :: tmp2r ! temporary for ncdf
    ! read in
    REAL(KIND=4), DIMENSION(:, :, :), POINTER    :: tmp3r ! temporary for ncdf
    ! read in
    REAL(KIND=4), DIMENSION(:, :, :, :), POINTER :: tmp4r ! temporary for ncdf
    ! read in
    REAL :: tmpjh

    ! Check if parameter exists:
    ok = NF90_INQ_VARID(ncid, parname, parID)
    IF(ok /= NF90_NOERR) THEN ! if it doesn't exist
       completeSet = .FALSE.
       ! If this routine is reading from the restart, abort
       IF(PRESENT(from_restart)) CALL nc_abort(ok, 'Error reading '//parname   &
            //' in file '//TRIM(filename)// '(SUBROUTINE readpar_r2)')
    ELSE
       exists%parameters = .TRUE. ! Note that pars were found in file
       ! Decide which 2nd dimension of parameter/init state we're loading:
       IF(dimswitch == 'ms') THEN
          dimctr = ms ! i.e. horizontal spatial and soil
       ELSE IF(dimswitch == 'snow') THEN
          dimctr = msn ! i.e. horizontal spatial and snow
       ELSE IF(dimswitch == 'nrb') THEN
          dimctr = nrb ! i.e. horizontal spatial and radiation bands
       ELSE IF(dimswitch == 'ncp') THEN
          dimctr = ncp ! i.e. horizontal spatial and plant carbon pools
       ELSE IF(dimswitch == 'ncs') THEN
          dimctr = ncs ! i.e. horizontal spatial and soil carbon pools
       ELSE
          CALL abort('Parameter or initial state '//parname//                  &
               ' called with unknown dimension switch - '//dimswitch//   &
               ' - in INTERFACE readpar SUBROUTINE readpar_r2')
       END IF
       ! Check for grid type - restart file uses land type grid
       IF(metGrid == 'land' .OR. PRESENT(from_restart)) THEN
          ! Collect data from land only grid in netcdf file.
          ! First, check whether parameter has patch dimension:
          ok = NF90_INQUIRE_VARIABLE(ncid, parID, ndims=pardims)
          IF(pardims == 2) THEN ! no patch dimension, just a land + other
             ! dimension
             IF(PRESENT(from_restart)) THEN
                ok = NF90_GET_VAR(ncid, parID, var_r2, start=(/1, 1/),         &
                     count=(/INpatch, dimctr/))
                !    WRITE(45,*) 'Is tgg read here?'
                IF(ok /= NF90_NOERR) CALL nc_abort                             &
                     (ok, 'Error reading '//parname//' in file' &
                     //TRIM(filename)//' (SUBROUTINE readpar_rd)')
             ELSE
                ALLOCATE(tmp2r(1, dimctr))
                DO i = 1, mland ! over all land points/grid cells
                   ok = NF90_GET_VAR(ncid, parID, tmp2r,                       &
                        start=(/i, 1/), count=(/1, dimctr/))
                   IF(ok /= NF90_NOERR) CALL nc_abort                          &
                        (ok, 'Error reading '//parname//' in file ' &
                        //TRIM(filename)//' (SUBROUTINE readpar_r2)')
                   DO j = 1, dimctr
                      ! Set all patches to have the same value:
                      var_r2(landpt(i)%cstart:landpt(i)%cend, j) = tmp2r(1, j)
                   END DO
                END DO
                DEALLOCATE(tmp2r)
             END IF
          ELSE IF(pardims == 3) THEN ! i.e. parameter has a patch dimension
             ALLOCATE(tmp3r(1, npatch, dimctr))
             DO i = 1, mland ! over all land points/grid cells
                ok = NF90_GET_VAR(ncid, parID, tmp3r,                          &
                     start=(/i, 1, 1/), count=(/1, npatch, dimctr/))
                IF(ok /= NF90_NOERR) CALL nc_abort                             &
                     (ok, 'Error reading '//parname//' in file ' &
                     //TRIM(filename)//' (SUBROUTINE readpar_r2)')
                DO j = 1, dimctr
                   ! Set values for this par for the # patches that exist
                   var_r2(landpt(i)%cstart:(landpt(i)%cstart + npatch          &
                        - 1), j) = tmp3r(1,:,j)
                END DO
             END DO
             DEALLOCATE(tmp3r)
          ELSE
             CALL abort('Dimension of '//parname//' parameter in met file '//  &
                  'unknown.')
          END IF
       ELSEIF(metGrid == 'mask') THEN ! Get data from land/sea mask type grid:
          ! First, check whether parameter has patch dimension:
          ok=NF90_INQUIRE_VARIABLE(ncid, parID, ndims=pardims)

          IF(pardims == 3) THEN ! no patch dimension, just x-y + soil grid
             ! dimension
             ALLOCATE(tmp3r(1, 1, ms))
             DO i = 1, mland ! over all land points/grid cells
                ok =  NF90_GET_VAR(ncid, parID, tmp3r,                         &
                     start=(/land_x(i), land_y(i), 1/),          &
                     count=(/1, 1, dimctr/))
                IF(ok /= NF90_NOERR) CALL nc_abort                             &
                     (ok, 'Error reading '//parname//' in file ' &
                     //TRIM(filename)//' (SUBROUTINE readpar_r2)')
                ! Set all patches to have the same value for this par:
                DO j = 1, dimctr
                   var_r2(landpt(i)%cstart:landpt(i)%cend,j) = tmp3r(1,1,j)
                END DO
             END DO
             DEALLOCATE(tmp3r)
          ELSE IF(pardims == 4) THEN ! i.e. soil parameter has a patch dimension
             ALLOCATE(tmp4r(1, 1, npatch, dimctr))
             DO  i = 1, mland ! over all land points/grid cells
                ok = NF90_GET_VAR(ncid, parID, tmp4r,                          &
                     start=(/land_x(i),land_y(i), 1, 1/),         &
                     count=(/1, 1, npatch, dimctr/))
                IF(ok /= NF90_NOERR) CALL nc_abort                             &
                     (ok, 'Error reading '//parname//' in file ' &
                     //TRIM(filename)//' (SUBROUTINE readpar_r2)')
                DO j = 1, dimctr
                   ! Set values for this par for the # patches that exist
                   var_r2(landpt(i)%cstart:(landpt(i)%cstart + npatch -1 ), j) &
                        = tmp4r(1, 1, :, j)
                END DO
             END DO
             DEALLOCATE(tmp4r)
          ELSE IF(dimswitch == 'nrb') THEN
             PRINT *, 'pardims', pardims
             IF(pardims == 2) THEN ! no patch dimension, just a land + other
                ! dimension
                IF(PRESENT(from_restart)) THEN
                   ok = NF90_GET_VAR(ncid, parID, var_r2, start=(/1, 1/),      &
                        count=(/INpatch, dimctr/))
                   IF(ok /= NF90_NOERR) CALL nc_abort                          &
                        (ok,'Error reading '//parname//' in file' &
                        //TRIM(filename)//' (SUBROUTINE readpar_rd)')
                ELSE
                   DO i = 1, mland ! over all land points/grid cells
                      ok = NF90_GET_VAR(ncid, parID, tmpjh, start=(/i/))
                      IF(ok /= NF90_NOERR) CALL nc_abort                          &
                           (ok, 'Error reading '//parname//' in file ' &
                           //TRIM(filename)//' (SUBROUTINE readpar_r2)')
                      ! Set all patches to have the same value:
                      PRINT *, 'read albsoil: ', tmpjh
                      var_r2(landpt(i)%cstart:landpt(i)%cend, 1) = tmpjh
                      var_r2(landpt(i)%cstart:landpt(i)%cend, 2) = tmpjh
                   END DO
                END IF
             END IF
          ELSE
             CALL abort('Dimension of '//parname//' parameter in met file '//  &
                  'unknown.')
          END IF
       END IF ! gridtype land or mask
    END IF ! parameter's existence

  END SUBROUTINE readpar_r2
  !=============================================================================
  SUBROUTINE readpar_r2d(ncid, parname, completeSet, var_r2d, filename,        &
       npatch, dimswitch, from_restart, INpatch)
    ! Subroutine for loading a double precision two dimensional real-valued
    ! soil dimensioned parameter
    INTEGER, INTENT(IN) :: ncid ! netcdf file ID
    INTEGER, INTENT(IN) :: npatch ! # of veg patches in parameter's file
    INTEGER, INTENT(IN), OPTIONAL :: INpatch
    REAL(r_2), DIMENSION(:, :), INTENT(INOUT) :: var_r2d ! returned parameter
    ! value
    LOGICAL, INTENT(IN), OPTIONAL :: from_restart ! reading from restart file?
    LOGICAL, INTENT(INOUT) :: completeSet ! has every parameter been loaded?
    CHARACTER(LEN=*), INTENT(IN) :: parname ! name of parameter
    CHARACTER(LEN=*), INTENT(IN) :: filename ! file containing parameter values
    CHARACTER(LEN=*), INTENT(IN) :: dimswitch ! indicates dimesnion of parameter

    INTEGER :: parID ! parameter's netcdf ID
    INTEGER :: pardims ! # dimensions of parameter
    INTEGER :: dimctr ! size of non-spatial (2nd) dimension of parameter
    INTEGER :: i,j ! do loop counter
    REAL(8), DIMENSION(:, :), POINTER       :: tmp2rd ! temporary for ncdf
    ! read in
    REAL(4), DIMENSION(:, :), POINTER       :: tmp2r  ! temporary for ncdf
    ! read in
    REAL(4), DIMENSION(:, :, :), POINTER    :: tmp3r  ! temporary for ncdf
    ! read in
    REAL(4), DIMENSION(:, :, :, :), POINTER :: tmp4r  ! temporary for ncdf
    ! read in

    ! Check if parameter exists:
    ok = NF90_INQ_VARID(ncid,parname,parID)
    IF(ok /= NF90_NOERR) THEN ! if it doesn't exist
       completeSet = .FALSE.
       ! If this routine is reading from the restart, abort
       IF(PRESENT(from_restart))  WRITE(*,*) ' Error reading '//parname//' in file ' &
            //TRIM(filename)//' (SUBROUTINE readpar_r2d)'
    ELSE
       exists%parameters = .TRUE. ! Note that pars were found in file
       ! Decide which 2nd dimension of parameter /init state we're loading:
       IF(dimswitch(1:2) == 'ms') THEN
          dimctr = ms ! i.e. horizontal spatial and soil
       ELSE IF(dimswitch(1:4) == 'snow') THEN
          dimctr = msn ! i.e. horizontal spatial and snow
       ELSE IF(dimswitch(1:3) == 'nrb') THEN
          dimctr = nrb ! i.e. horizontal spatial and radiation bands
       ELSE IF(dimswitch(1:3) == 'ncp') THEN
          dimctr = ncp ! i.e. horizontal spatial and plant carbon pools
       ELSE IF(dimswitch(1:3) == 'ncs') THEN
          dimctr = ncs ! i.e. horizontal spatial and soil carbon pools
       ELSE
          CALL abort('Parameter or initial state '//parname//                  &
               ' called with unknown dimension switch - '//dimswitch//   &
               ' - in INTERFACE readpar')
       END IF
       ! Check for grid type - restart file uses land type grid
       IF(metGrid == 'land' .OR. PRESENT(from_restart)) THEN
          ! Collect data from land only grid in netcdf file.
          ! First, check whether parameter has patch dimension:
          ok = NF90_INQUIRE_VARIABLE(ncid, parID, ndims=pardims)
          IF(pardims == 2) THEN ! no patch dimension, just a land+soil
             ! dimensions
             ! If we really are reading a double precision variable
             ! from the netcdf restart file, dimswitch will show this:
             ! equivalent to using "IF(PRESENT(from_restart)) THEN"
             IF(dimswitch == 'msd' .OR. dimswitch == 'snowd' .OR.              &
                  dimswitch == 'nrbd' .OR. dimswitch == 'ncpd'                   &
                  .OR. dimswitch == 'ncsd') THEN
                ALLOCATE(tmp2rd(INpatch, dimctr))
                ok = NF90_GET_VAR(ncid, parID, tmp2rd,                          &
                     start=(/1, 1/), count=(/INpatch, dimctr/))
                IF(ok /= NF90_NOERR) CALL nc_abort                              &
                     (ok, 'Error reading '//parname//' in met data file ' &
                     //TRIM(filename)//' (SUBROUTINE readpar_r2d)')
                var_r2d(:, :) = REAL(tmp2rd(:, :), r_2)
                DEALLOCATE(tmp2rd)
                !              ALLOCATE(tmp2rd(1,dimctr))
                !              DO i=1, mland ! over all land points/grid cells
                !                 ok= NF90_GET_VAR(ncid, parID, tmp2rd,                        &
                !                                  start=(/i,1/), count=(/1,dimctr/))
                !                 IF(ok /= NF90_NOERR) CALL nc_abort                           &
                !                    (ok,'Error reading '//parname//' in met data file '       &
                !                      //TRIM(filename)//' (SUBROUTINE readpar_r2d)')
                !                 DO j=1, dimctr
                !                    var_r2d(landpt(i)%cstart:landpt(i)%cend,j) =              &
                !                      REAL(tmp2rd(1,j),r_2)
                !                 END DO
                !              END DO
                !              DEALLOCATE(tmp2rd)
                ! WRITE(45,*) 'After read-in restart values'
                ! WRITE(45,*) '1039_var_r2d = ', var_r2d(1039,:)
                ! WRITE(45,*) '1672_var_r2d = ', var_r2d(1672,:)
             ELSE
                ALLOCATE(tmp2r(1, dimctr))
                DO i = 1, mland ! over all land points/grid cells
                   ok = NF90_GET_VAR(ncid, parID, tmp2r,                       &
                        start=(/i, 1/), count=(/1, dimctr/))
                   IF(ok /= NF90_NOERR) CALL nc_abort                          &
                        (ok, 'Error reading '//parname//' in met data file '    &
                        //TRIM(filename)//' (SUBROUTINE readpar_r2d)')
                   DO j = 1, dimctr
                      var_r2d(landpt(i)%cstart:landpt(i)%cend, j) =            &
                           REAL(tmp2r(1,j))
                   END DO
                END DO
                DEALLOCATE(tmp2r)
             END IF ! reading a d.p. var from netcdf
          ELSE IF(pardims == 3) THEN ! i.e. parameter has a patch dimension
             ! Note that restart file doesn't have a patch dimension,
             ! so that reads below are of single precision vares from met file
             ALLOCATE(tmp3r(1,npatch,dimctr))
             DO i = 1, mland ! over all land points/grid cells
                ok = NF90_GET_VAR(ncid, parID, tmp3r,                          &
                     start=(/i, 1, 1/), count=(/1, npatch, dimctr/))
                IF(ok /= NF90_NOERR) CALL nc_abort                             &
                     (ok, 'Error reading '//parname//' in met data file ' &
                     //TRIM(filename)//' (SUBROUTINE readpar_r2d)')
                DO j = 1, dimctr
                   ! Set values for this par for the # patches that exist
                   var_r2d(landpt(i)%cstart:(landpt(i)%cstart + npatch - 1),j) &
                        = REAL(tmp3r(1,:,j),r_2)
                END DO
             END DO
             DEALLOCATE(tmp3r)
          ELSE
             CALL abort('Dimension of '//parname//' parameter in met file'//   &
                  'unknown.')
          END IF
       ELSEIF(metGrid == 'mask') THEN ! Get data from land/sea mask type grid:
          ! NB restart file won't have mask grid, therefore below we are
          ! reading single precision variables from the met file
          ! First, check whether parameter has patch dimension:
          ok = NF90_INQUIRE_VARIABLE(ncid, parID, ndims=pardims)
          IF(pardims == 3) THEN ! no patch dimension, just x-y + soil grid
             ! dimension
             ALLOCATE(tmp3r(1, 1, dimctr))
             DO i = 1, mland ! over all land points/grid cells
                ok = NF90_GET_VAR(ncid, parID, tmp3r,                          &
                     start=(/land_x(i), land_y(i), 1/),           &
                     count=(/1, 1, dimctr/))
                IF(ok /= NF90_NOERR) CALL nc_abort                             &
                     (ok, 'Error reading '//parname//' in met data file ' &
                     //TRIM(filename)//' (SUBROUTINE readpar_r2d)')
                ! Set all patches to have the same value for this par:
                DO j = 1, dimctr
                   var_r2d(landpt(i)%cstart:landpt(i)%cend, j) =               &
                        REAL(tmp3r(1, 1, j), r_2)
                END DO
             END DO
             DEALLOCATE(tmp3r)
          ELSE IF(pardims == 4) THEN ! i.e. soil parameter has a patch dimension
             ALLOCATE(tmp4r(1,1,npatch,dimctr))
             DO i = 1, mland ! over all land points/grid cells
                ok = NF90_GET_VAR(ncid, parID, tmp4r,                          &
                     start=(/land_x(i), land_y(i), 1, 1/),        &
                     count=(/1, 1, npatch, dimctr/))
                IF(ok /= NF90_NOERR) CALL nc_abort                             &
                     (ok,'Error reading '//parname//' in met data file ' &
                     //TRIM(filename)//' (SUBROUTINE readpar_r2d)')
                DO j = 1, dimctr
                   ! Set values for this par for the # patches that exist
                   var_r2d(landpt(i)%cstart:(landpt(i)%cstart + npatch         &
                        - 1), j) = REAL(tmp4r(1, 1, :, j), r_2)
                END DO
             END DO
             DEALLOCATE(tmp4r)
          ELSE
             CALL abort('Dimension of '//parname//' parameter in met file'//   &
                  'unknown.')
          END IF
       END IF ! gridtype land or mask
    END IF ! parameter's existence

  END SUBROUTINE readpar_r2d
  !=============================================================================
  SUBROUTINE redistr_i(INpatch, nap, in_i, out_i, parname)
    IMPLICIT NONE
    INTEGER,     INTENT(IN)  :: INpatch
    INTEGER,     INTENT(IN)  :: nap(INpatch)
    INTEGER,     INTENT(IN)  :: in_i(INpatch)
    INTEGER,     INTENT(OUT) :: out_i(mp)
    CHARACTER(LEN=*), INTENT(IN)  :: parname ! name of parameter

    ! local variables
    !    REAL    :: ave_r
    INTEGER :: ii, jj, npt

    npt = 0
    DO ii = 1, mland
       !     ave_r = 0.0
       DO jj = 1, nap(ii)
          npt = npt + 1
          !       ave_r = ave_r + in_i(npt)
       END DO
       !     ave_r = ave_r / FLOAT(nap(ii))
       !     out_i(landpt(ii)%cstart:landpt(ii)%cend) = INT(ave_r)
       ! just take the dominant one for isflag
       out_i(landpt(ii)%cstart:landpt(ii)%cend) = in_i(npt-nap(ii) + 1)
    END DO
    IF (npt /= INpatch) THEN
       PRINT *, parname,' Error: npt /= INpatch, ',npt, INpatch
       STOP
    END IF

  END SUBROUTINE redistr_i

  SUBROUTINE redistr_r(INpatch, nap, in_r, out_r, parname)
    IMPLICIT NONE
    INTEGER,     INTENT(IN)  :: INpatch
    INTEGER,     INTENT(IN)  :: nap(INpatch)
    REAL,        INTENT(IN)  :: in_r(INpatch)
    REAL,        INTENT(OUT) :: out_r(mp)
    CHARACTER(LEN=*), INTENT(IN)  :: parname ! name of parameter

    ! local variables
    REAL    :: ave_r
    INTEGER :: ii, jj, npt

    npt = 0
    DO ii = 1, mland
       ave_r = 0.0
       DO jj = 1, nap(ii)
          npt = npt + 1
          ave_r = ave_r + in_r(npt)
       END DO
       ave_r = ave_r / FLOAT(nap(ii))
       out_r(landpt(ii)%cstart:landpt(ii)%cend) = ave_r
    END DO
    IF (npt /= INpatch) THEN
       PRINT *, parname,' Error: npt /= INpatch, ',npt, INpatch
       STOP
    END IF

  END SUBROUTINE redistr_r

  SUBROUTINE redistr_rd(INpatch,nap,in_rd,out_rd,parname)
    IMPLICIT NONE
    INTEGER,     INTENT(IN)  :: INpatch
    INTEGER,     INTENT(IN)  :: nap(INpatch)
    REAL(r_2),        INTENT(IN)  :: in_rd(INpatch)
    REAL(r_2),        INTENT(OUT) :: out_rd(mp)
    CHARACTER(LEN=*), INTENT(IN)  :: parname ! name of parameter

    ! local variables
    REAL(r_2)    :: ave_rd
    INTEGER :: ii, jj, npt

    npt = 0
    DO ii = 1, mland
       ave_rd = 0.0
       DO jj = 1, nap(ii)
          npt = npt + 1
          ave_rd = ave_rd + in_rd(npt)
       END DO
       ave_rd = ave_rd / FLOAT(nap(ii))
       out_rd(landpt(ii)%cstart:landpt(ii)%cend) = ave_rd
    END DO
    IF (npt /= INpatch) THEN
       PRINT *, parname,' Error: npt /= INpatch, ',npt, INpatch
       STOP
    END IF

  END SUBROUTINE redistr_rd

  SUBROUTINE redistr_r2(INpatch, nap,in_r2, out_r2, parname, dim2)
    IMPLICIT NONE
    INTEGER,     INTENT(IN)  :: INpatch
    INTEGER,     INTENT(IN)  :: dim2
    INTEGER,     INTENT(IN)  :: nap(INpatch)
    REAL,        INTENT(IN)  :: in_r2 (INpatch,dim2)
    REAL,        INTENT(OUT) :: out_r2(mp,dim2)
    CHARACTER(LEN=*), INTENT(IN)  :: parname ! name of parameter

    ! local variables
    REAL    :: ave_r2(dim2)
    INTEGER :: ii, jj, npt

    npt = 0
    DO ii = 1, mland
       ave_r2(:) = 0.0
       DO jj = 1, nap(ii)
          npt = npt + 1
          ave_r2(:) = ave_r2(:) + in_r2(npt,:)
       END DO
       ave_r2(:) = ave_r2(:) / FLOAT(nap(ii))
       DO jj = 1, dim2
          out_r2(landpt(ii)%cstart:landpt(ii)%cend, jj) = ave_r2(jj)
       END DO
    END DO
    IF (npt /= INpatch) THEN
       PRINT *, parname,' Error: npt /= INpatch, ',npt, INpatch
       STOP
    END IF

  END SUBROUTINE redistr_r2

  SUBROUTINE redistr_r2d(INpatch,nap,in_r2d,out_r2d,parname,dim2)
    IMPLICIT NONE
    INTEGER,     INTENT(IN)  :: INpatch
    INTEGER,     INTENT(IN)  :: dim2
    INTEGER,     INTENT(IN)  :: nap(INpatch)
    REAL(r_2),        INTENT(IN)  :: in_r2d (INpatch,dim2)
    REAL(r_2),        INTENT(OUT) :: out_r2d(mp,dim2)
    CHARACTER(LEN=*), INTENT(IN)  :: parname ! name of parameter

    ! local variables
    REAL(r_2)    :: ave_r2d(dim2)
    INTEGER :: ii, jj, npt

    npt = 0
    DO ii = 1, mland
       ave_r2d(:) = 0.0
       DO jj = 1, nap(ii)
          npt = npt + 1
          ave_r2d(:) = ave_r2d(:) + in_r2d(npt,:)
       END DO
       ave_r2d(:) = ave_r2d(:) / FLOAT(nap(ii))
       DO jj = 1, dim2
          out_r2d(landpt(ii)%cstart:landpt(ii)%cend, jj) = ave_r2d(jj)
       END DO
    END DO
    IF (npt /= INpatch) THEN
       PRINT *, parname,' Error: npt /= INpatch, ',npt, INpatch
       STOP
    END IF

  END SUBROUTINE redistr_r2d


END MODULE cable_read_module