    module CalcLike
    use DataLikelihoodList
    use GeneralTypes
    use BaseParameters
    use MatrixUtils
    use MiscUtils
    implicit none
    private

    Type, extends(TConfigClass) :: TLikeCalculator
        real(mcp) :: Temperature =1
        logical :: test_likelihood= .false.
        logical :: timing = .false.
        real(mcp), allocatable :: test_cov_matrix(:,:)
    contains
    procedure :: AddLike
    procedure :: AddLikeTemp
    procedure :: GetLogLikeBounds
    procedure :: GetLogPriors
    procedure :: GetLogLike
    procedure :: GetLogLikeMain
    procedure :: ReadParams => TLikeCalculator_ReadParams
    procedure :: TestLikelihoodFunction => TLikeCalculator_TestLikelihoodFunction
    procedure :: WritePerformanceStats => TLikeCalculator_WritePerformanceStats
    procedure :: WriteParamsHumanText_unit => TLikeCalculator_WriteParamsHumanText
    procedure :: WriteParamsHumanText_file => TLikeCalculator_WriteParamsHumanTextFile
    procedure :: WriteParamPointTextData => TLikeCalculator_WriteParamPointTextData
    generic :: WriteParamsHumanText => WriteParamsHumanText_unit, WriteParamsHumanText_file
    end type TLikeCalculator

    type, extends(TLikeCalculator) :: TGenericLikeCalculator
    contains
    procedure :: GetLogLikeMain => Generic_GetLogLikeMain
    end type TGenericLikeCalculator

    type, extends(TLikeCalculator) :: TTheoryLikeCalculator
        class(TTheoryParams), allocatable :: TheoryParams
        class(TCalculationAtParamPoint), pointer :: Params
        logical changeMask(max_num_params)
        logical SlowChanged, SemiSlowchanged
    contains
    procedure :: GetLogLikeMain => TheoryLike_GetLogLikeMain
    procedure :: GetLogLikePost => TheoryLike_GetLogLikePost
    procedure :: SetTheoryParams => TheoryLike_SetTheoryParams
    procedure :: CheckPriorCuts => TheoryLike_CheckPriorCuts
    procedure :: CalculateRequiredTheoryChanges =>TheoryLike_CalculateRequiredTheoryChanges
    procedure :: GetTheoryForLike=>TheoryLike_GetTheoryForLike
    procedure :: GetTheoryForImportance=>TheoryLike_GetTheoryForImportance
    procedure :: GetLogLikeWithTheorySet => TheoryLike_LogLikeWithTheorySet
    procedure :: UpdateTheoryForLikelihoods => TheoryLike_UpdateTheoryForLikelihoods
    procedure :: SetNewTheoryResults => TheoryLike_SetNewTheoryResults
    procedure :: TestLikelihoodFunction => TheoryLike_TestLikelihoodFunction
    procedure :: WriteParamsHumanText_unit => TTheoryLike_WriteParamsHumanText
    procedure :: WriteParamPointTextData => TTheoryLike_WriteParamPointTextData
    end type TTheoryLikeCalculator

    type, extends(TCheckpointable) :: TLikelihoodUser
        class(TLikeCalculator), pointer :: LikeCalculator => null()
    end type

    type, extends(TCheckpointable) :: TTheoryLikelihoodUser
        class(TTheoryLikeCalculator), pointer :: LikeCalculator => null()
    end type

    public TLikeCalculator, TGenericLikeCalculator, TTheoryLikeCalculator, TLikelihoodUser, TTheoryLikelihoodUser
    contains

    subroutine AddLike(this, CurrentLike, LikeToAdd)
    class(TLikeCalculator) :: this
    real(mcp), intent(in) :: LikeToAdd
    real(mcp) CurrentLike

    if (CurrentLike/=LogZero) then
        if (LikeToAdd == logZero) then
            CurrentLike = LogZero
        else
            CurrentLike = CurrentLike + LikeToAdd
        end if
    end if
    end subroutine AddLike

    subroutine AddLikeTemp(this, CurrentLike, LikeToAdd)
    class(TLikeCalculator) :: this
    real(mcp), intent(in) :: LikeToAdd
    real(mcp) CurrentLike

    if (CurrentLike/=LogZero) then
        if (LikeToAdd == logZero) then
            CurrentLike = LogZero
        else
            CurrentLike = CurrentLike + LikeToAdd/this%Temperature
        end if
    end if
    end subroutine AddLikeTemp

    function GetLogLikeBounds(this,Params)
    class(TLikeCalculator) :: this
    class(TCalculationAtParamPoint):: Params
    real(mcp) :: GetLogLikeBounds

    if (any(Params%P(:num_params) > BaseParams%PMax(:num_params)) .or. &
        & any(Params%P(:num_params) < BaseParams%PMin(:num_params))) then
    GetLogLikeBounds = logZero
    else
        GetLogLikeBounds=0
    end if

    end function GetLogLikeBounds

    function GetLogPriors(this, P) result(logLike)
    class(TLikeCalculator) :: this
    integer i
    real(mcp), intent(in) :: P(num_params)
    real(mcp) logLike

    logLike=0
    do i=1,num_params
        if ((BaseParams%varying(i) .or. BaseParams%include_fixed_parameter_priors) &
            .and. BaseParams%GaussPriors%std(i)/=0) then
        logLike = logLike + ((P(i)-BaseParams%GaussPriors%mean(i))/BaseParams%GaussPriors%std(i))**2
        end if
    end do

    do i= 1, size(BaseParams%LinearCombinations)
        associate(Comb => BaseParams%LinearCombinations(i))
            if (Comb%std/=0) then
                logLike = logLike + ((dot_product(Comb%Combination,P) -Comb%mean)/Comb%std)**2
            end if
        end associate
    end do
    logLike=logLike/2

    end function GetLogPriors

    function GetLogLike(this, Params) !Get -Ln(Likelihood) for chains
    class(TLikeCalculator) :: this
    class(TCalculationAtParamPoint) :: Params
    real(mcp) GetLogLike

    GetLogLike = this%GetLogLikeBounds(Params)
    if (GetLogLike==LogZero) return
    if (this%test_likelihood) then
        call this%AddLikeTemp(GetLogLike,this%TestLikelihoodFunction(Params))
    else
        call this%AddLikeTemp(GetLogLike,this%GetLogLikeMain(Params))
    end if
    if (GetLogLike==LogZero) return
    call this%AddLikeTemp(GetLogLike,this%getLogPriors(Params%P))

    end function GetLogLike

    function GetLogLikeMain(this, Params) result(LogLike)!Get -Ln(Likelihood) for chains
    class(TLikeCalculator) :: this
    class(TCalculationAtParamPoint) :: Params
    real(mcp) :: LogLike

    LogLike = LogZero !error - must be overridden

    end function GetLogLikeMain

    subroutine TLikeCalculator_ReadParams(this, Ini)
    class(TLikeCalculator) :: this
    class(TSettingIni) :: Ini
    character(LEN=:), pointer :: covMatrix

    this%test_likelihood = Ini%Read_Logical('test_likelihood', .false.)
    if (this%test_likelihood) then
        print *,'** Using test Gaussian likelihood from covariance + hard priors **'
        covMatrix => Ini%Read_String('test_covariance')
        if (covMatrix/='') then
            allocate(this%test_cov_matrix(num_params_used, num_params_used))
            call BaseParams%ReadSetCovMatrix(covMatrix, this%test_cov_matrix)
        end if
    end if
    call Ini%Read('temperature',this%Temperature)

    end subroutine TLikeCalculator_ReadParams

    function TLikeCalculator_TestLikelihoodFunction(this,Params) result(LogLike)
    class(TLikeCalculator) :: this
    class(TCalculationAtParamPoint) Params
    real(mcp) :: LogLike
    real(mcp), allocatable, save :: covInv(:,:)
    real(mcp) X(num_params_used)

    if (.not. allocated(covInv)) then
        allocate(covInv(num_params_used,num_params_used))
        if (.not. allocated(this%test_cov_matrix)) then
            covInv = BaseParams%covariance_estimate
        else
            covInv = this%test_cov_matrix
        endif
        call Matrix_Inverse(covInv)
    end if
    X = Params%P(params_used) - BaseParams%Center(params_used)
    LogLike = dot_product(X, matmul(covInv, X))/2

    end function TLikeCalculator_TestLikelihoodFunction

    subroutine TLikeCalculator_WritePerformanceStats(this, unit)
    class(TLikeCalculator) :: this
    integer, intent(in) :: unit

    end subroutine TLikeCalculator_WritePerformanceStats

    subroutine TLikeCalculator_WriteParamsHumanText(this, aunit, P, LogLike, weight)
    class(TLikeCalculator) :: this
    class(TCalculationAtParamPoint) P
    real(mcp), intent(in), optional :: LogLike,weight
    integer, intent(in) :: aunit
    integer isused,i

    if (present(weight)) then
        write (aunit,*) ' weight    = ',weight
    end if

    if (present(LogLike)) then
        write (aunit,*) '-log(Like) = ',LogLike
        write (aunit,*) ' chi-sq    = ',LogLike*2
        write (aunit,*) ''
    end if

    do isused = 0,1
        do i=1, num_params
            if (isused==0 .and. BaseParams%varying(i) .or. isused==1 .and. .not. BaseParams%varying(i)) then
                write(aunit,'(1I5,1E15.7,"   ",1A22)', advance='NO') &
                    i, P%P(i), BaseParams%NameMapping%name(i)
                write (aunit,'(a)') trim(BaseParams%NameMapping%label(i))
            end if
        end do
        write (aunit,*) ''
    end do

    end subroutine TLikeCalculator_WriteParamsHumanText

    subroutine TLikeCalculator_WriteParamsHumanTextFile(this, fname, P, LogLike, weight)
    class(TLikeCalculator) :: this
    character(LEN=*), intent(in) :: fname
    class(TCalculationAtParamPoint) P
    real(mcp), intent(in), optional :: LogLike, weight
    Type(TTextFile) F

    call F%CreateFile(fname)
    call this%WriteParamsHumanText(F%unit, P, LogLike, weight)
    call F%Close()

    end subroutine TLikeCalculator_WriteParamsHumanTextFile

    subroutine TLikeCalculator_WriteParamPointTextData(this, output_root, Params)
    class(TLikeCalculator) :: this
    character(LEN=*), intent(in) :: output_root
    class(TCalculationAtParamPoint) Params
    end subroutine TLikeCalculator_WriteParamPointTextData

    function Generic_GetLogLikeMain(this, Params) result(LogLike)!Get -Ln(Likelihood) for chains
    class(TGenericLikeCalculator) :: this
    class(TCalculationAtParamPoint) :: Params
    real(mcp) LogLike

    !Used when you want to plug in your own CMB-independent likelihood function:
    !Parameter array is Params%P, so e.g. 2D unit Gaussian would be
    LogLike = (Params%P(1)**2+Params%P(2)**2)/2
    !LogLike = LogZero
    !call MpiStop('Generic_GetLogLikeMain: need to write this function!')

    end function Generic_GetLogLikeMain

    subroutine TheoryLike_SetTheoryParams(this, Params)
    class(TTheoryLikeCalculator) :: this
    class(TCalculationAtParamPoint), target :: Params

    if (.not. allocated(this%TheoryParams)) call this%Config%Parameterization%NewTheoryParams(this%TheoryParams)
    call this%Config%Parameterization%ParamArrayToTheoryParams(Params%P,this%TheoryParams)
    this%Params => Params

    end subroutine TheoryLike_SetTheoryParams

    subroutine TheoryLike_SetNewTheoryResults(this, Params)
    class(TTheoryLikeCalculator) :: this
    class(TCalculationAtParamPoint) :: Params

    if (.not. allocated(Params%Theory)) call this%Config%NewTheory(Params%Theory)

    end subroutine TheoryLike_SetNewTheoryResults

    function TheoryLike_GetLogLikeMain(this, Params) result(LogLike)
    !Get -Ln(Likelihood), not accounting for temperature
    class(TTheoryLikeCalculator) :: this
    class(TCalculationAtParamPoint) :: Params
    real(mcp) LogLike

    call this%SetTheoryParams(Params)
    LogLike = this%Config%Parameterization%NonBaseParameterPriors(this%TheoryParams)
    if (LogLike == logZero) return
    if (.not. Params%validInfo) then
        this%changeMask(1:num_params) = .true.
    else
        this%changeMask(1:num_params) = Params%lastParamArray(1:num_params)/=Params%P(1:num_params)
    end if
    call this%SetNewTheoryResults(Params)
    if (this%CalculateRequiredTheoryChanges()) then
        call this%AddLike(LogLike, this%GetLogLikeWithTheorySet())
        Params%lastParamArray(1:num_params) = Params%P(1:num_params)
    else
        LogLike = logZero
    end if
    if (LogLike==logZero) return

    if (Feedback>2) call DataLikelihoods%WriteLikelihoodContribs(stdout, Params%likelihoods)

    end function TheoryLike_GetLogLikeMain

    function TheoryLike_CheckPriorCuts(this, Params) result(checkPriorCuts)
    class(TTheoryLikeCalculator) :: this
    real(mcp)  CheckPriorCuts
    class(TCalculationAtParamPoint) :: Params

    CheckPriorCuts = this%GetLogLikeBounds(Params)
    if (CheckPriorCuts==LogZero) return

    call this%SetTheoryParams(Params)
    CheckPriorCuts = this%Config%Parameterization%NonBaseParameterPriors(this%TheoryParams)

    end function TheoryLike_CheckPriorCuts

    function TheoryLike_GetLogLikePost(this,Params, do_like) result(LogLike)
    !for importance sampling where theory may be pre-stored
    class(TTheoryLikeCalculator) :: this
    real(mcp)  LogLike
    class(TCalculationAtParamPoint) :: Params
    logical, optional, intent(in) :: do_like(DataLikelihoods%count)

    LogLike = this%GetLogLikeBounds(Params)
    if (LogLike==LogZero) return

    this%SlowChanged = .false.
    this%ChangeMask = .true.

    call this%SetTheoryParams(Params)
    call this%AddLikeTemp(LogLike,this%Config%Parameterization%NonBaseParameterPriors(this%TheoryParams))
    if (LogLike == logZero) return
    call this%AddLikeTemp(LogLike, this%GetLogLikeWithTheorySet(do_like))
    if (LogLike == logZero) return
    call this%AddLikeTemp(LogLike, this%GetLogPriors(Params%P))

    end function TheoryLike_GetLogLikePost

    function TheoryLike_LogLikeWithTheorySet(this, likelihood_mask) result(logLike)
    class(TTheoryLikeCalculator) :: this
    logical, intent(in), optional :: likelihood_mask(DataLikelihoods%count)
    real(mcp) logLike
    real(mcp) itemLike
    class(TDataLikelihood), pointer :: like => null()
    integer i
    logical :: do_like(DataLikelihoods%count)
    Type(TTimer) Timer

    if (present(likelihood_Mask)) then
        do_like = likelihood_mask
    else
        do_like = .true.
    end if
    logLike = logZero
    call this%GetTheoryForLike(null()) !chance to initalize
    do i= 1, DataLikelihoods%count
        if (do_like(i)) then
            like => DataLikelihoods%Item(i)
            if (any(like%dependent_params(1:num_params) .and. this%changeMask(1:num_params) )) then
                call this%GetTheoryForLike(like)
                if (this%timing) call Timer%Start
                itemLike = like%GetLogLike(this%TheoryParams, this%Params%Theory, this%Params%P(like%nuisance_indices))
                if (this%timing) call Timer%WriteTime('Time for '//trim(like%name))
                if (itemLike == logZero) return
                this%Params%Likelihoods(i) = itemLike
            end if
        end if
    end do
    logLike = sum(this%Params%likelihoods(1:DataLikelihoods%Count))

    end function TheoryLike_LogLikeWithTheorySet

    logical function TheoryLike_CalculateRequiredTheoryChanges(this)
    class(TTheoryLikeCalculator) :: this

    !Set this%Params theory entries (this%Params%Theory) as required for current this%changeMask and this%TheoryParams
    this%Params%validInfo = .true.
    TheoryLike_CalculateRequiredTheoryChanges = .true.

    end function TheoryLike_CalculateRequiredTheoryChanges

    subroutine TheoryLike_GetTheoryForLike(this,Like)
    class(TTheoryLikeCalculator) :: this
    class(TDataLikelihood), pointer :: like

    !If needed, likelihood specific calculation/initalization; like=null for first initial call
    end subroutine TheoryLike_GetTheoryForLike

    subroutine TheoryLike_GetTheoryForImportance(this,Params, error)
    class(TTheoryLikeCalculator) :: this
    class(TCalculationAtParamPoint), target :: Params
    integer error

    call this%SetTheoryParams(Params)
    call this%Config%Calculator%GetTheoryForImportance(this%TheoryParams, Params%Theory, error)

    end subroutine TheoryLike_GetTheoryForImportance

    subroutine TheoryLike_UpdateTheoryForLikelihoods(this, Params)
    class(TTheoryLikeCalculator) :: this
    class(TCalculationAtParamPoint) :: Params

    end subroutine TheoryLike_UpdateTheoryForLikelihoods

    function TheoryLike_TestLikelihoodFunction(this,Params) result(LogLike)
    class(TTheoryLikeCalculator) :: this
    class(TCalculationAtParamPoint) Params
    real(mcp) :: LogLike

    call this%SetNewTheoryResults(Params) !so derived parameters can be output OK
    LogLike = this%TLikeCalculator%TestLikelihoodFunction(Params)

    end function TheoryLike_TestLikelihoodFunction

    subroutine TTheoryLike_WriteParamsHumanText(this, aunit, P, LogLike, weight)
    class(TTheoryLikeCalculator) :: this
    class(TCalculationAtParamPoint) P
    real(mcp), intent(in), optional :: LogLike, weight
    integer, intent(in) :: aunit
    real(mcp), allocatable :: derived(:)
    integer :: numderived = 0
    integer i

    call this%TLikeCalculator%WriteParamsHumanText(aunit, P, LogLike, weight)

    call this%Config%Parameterization%CalcDerivedParams(P%P,P%Theory, derived)
    call DataLikelihoods%addLikelihoodDerivedParams(P%P, P%Theory, derived, P%Likelihoods, LogLike)
    if (allocated(derived)) numderived = size(derived)
    do i=1, numderived
        write(aunit,'(1I5,1E15.7,"   ",1A22)', advance='NO') &
            num_params+i, derived(i), BaseParams%NameMapping%name(num_params + i )
        write (aunit,'(a)') trim(BaseParams%NameMapping%label(num_params+i))
    end do

    if (present(LogLike)) then
        write(aunit,*) ''
        write(aunit,*) '-log(Like)     chi-sq   data'
        call DataLikelihoods%WriteLikelihoodContribs(aunit, P%likelihoods)
    end if

    end subroutine TTheoryLike_WriteParamsHumanText

    subroutine TTheoryLike_WriteParamPointTextData(this, output_root, Params)
    class(TTheoryLikeCalculator) :: this
    character(LEN=*), intent(in) :: output_root
    class(TCalculationAtParamPoint) Params

    if (allocated(Params%Theory)) then
        call DataLikelihoods%WriteDataForLikelihoods(Params%P, Params%Theory, output_root)
        call Params%Theory%WriteTextData(output_root)
    end if

    end subroutine TTheoryLike_WriteParamPointTextData

    end module CalcLike


C
C  Subroutine to read the file
C
      subroutine read_rtamps_netcdf_dum(nfid, manLevel, maxStaticIds,
     +     nInventoryBins, rawLevel, recNum, stdLevel, termLevel,
     +     tropLevel, editFlag, firstInBin, firstOverflow,
     +     globalInventory, indxRefr, invTime, inventory, irMan,
     +     isOverflow, lastInBin, lastRecord, nStaticIds, oiMan,
     +     optIndxRefr, prevRecord, storedObs, absHumidity,
     +     airDensity, baromPressure, bpMan, bpStd, bpTerm, bpTrop,
     +     dewPt, direction, dpMan, dpStd, dpTrop, drMan, drStd,
     +     elevation, geomHeight, geopHeight, ghMan, ghTerm, ghTrop,
     +     gpStd, gpTerm, latitude, longitude, precipWater,
     +     relHumidity, rhMan, rhStd, riseRate, shear, shearDir,
     +     shearMagX, shearMagY, spMan, spStd, speed, temperature,
     +     tpMan, tpStd, tpTrop, vaporPressure, velError, velSound,
     +     observationTime, receivedTime, reportTime, dataProvider,
     +     providerId, staticIds, stationName)
C
      include 'netcdf.inc'
      integer manLevel, maxStaticIds, nInventoryBins, rawLevel,
     +     recNum, stdLevel, termLevel, tropLevel,nfid, nf_vid,
     +     nf_status
      integer editFlag( rawLevel, recNum), firstInBin(nInventoryBins),
     +     firstOverflow, globalInventory, indxRefr( rawLevel,
     +     recNum), invTime(recNum), inventory(maxStaticIds), irMan(
     +     manLevel, recNum), isOverflow(recNum),
     +     lastInBin(nInventoryBins), lastRecord(maxStaticIds),
     +     nStaticIds, oiMan( manLevel, recNum), optIndxRefr(
     +     rawLevel, recNum), prevRecord(recNum), storedObs(recNum)
      real absHumidity( rawLevel, recNum), airDensity( rawLevel,
     +     recNum), baromPressure( rawLevel, recNum), bpMan(
     +     manLevel, recNum), bpStd( stdLevel, recNum), bpTerm(
     +     termLevel, recNum), bpTrop( tropLevel, recNum), dewPt(
     +     rawLevel, recNum), direction( rawLevel, recNum), dpMan(
     +     manLevel, recNum), dpStd( stdLevel, recNum), dpTrop(
     +     tropLevel, recNum), drMan( manLevel, recNum), drStd(
     +     stdLevel, recNum), elevation(recNum), geomHeight(
     +     rawLevel, recNum), geopHeight( rawLevel, recNum), ghMan(
     +     manLevel, recNum), ghTerm( termLevel, recNum), ghTrop(
     +     tropLevel, recNum), gpStd( stdLevel, recNum), gpTerm(
     +     termLevel, recNum), latitude(recNum), longitude(recNum),
     +     precipWater( rawLevel, recNum), relHumidity( rawLevel,
     +     recNum), rhMan( manLevel, recNum), rhStd( stdLevel,
     +     recNum), riseRate( rawLevel, recNum), shear( rawLevel,
     +     recNum), shearDir( rawLevel, recNum), shearMagX( rawLevel,
     +     recNum), shearMagY( rawLevel, recNum), spMan( manLevel,
     +     recNum), spStd( stdLevel, recNum), speed( rawLevel,
     +     recNum), temperature( rawLevel, recNum), tpMan( manLevel,
     +     recNum), tpStd( stdLevel, recNum), tpTrop( tropLevel,
     +     recNum), vaporPressure( rawLevel, recNum), velError(
     +     rawLevel, recNum), velSound( rawLevel, recNum)
      double precision observationTime(recNum), receivedTime(recNum),
     +     reportTime(recNum)
      character*12 providerId(recNum)
      character*24 staticIds(maxStaticIds)
      character*51 stationName(recNum)
      character*11 dataProvider(recNum)

C   Variables of type REAL
C
C     Variable        NETCDF Long Name
C      absHumidity  "Absolute Humidity"
C
        nf_status = NF_INQ_VARID(nfid,'absHumidity',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var absHumidity'
      endif
        nf_status = NF_GET_VAR_REAL(nfid,nf_vid,absHumidity)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var absHumidity'
      endif
C
C     Variable        NETCDF Long Name
C      airDensity   "Density of Air"
C
        nf_status = NF_INQ_VARID(nfid,'airDensity',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var airDensity'
      endif
        nf_status = NF_GET_VAR_REAL(nfid,nf_vid,airDensity)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var airDensity'
      endif
C
C     Variable        NETCDF Long Name
C      baromPressure"Pressure"
C
        nf_status = NF_INQ_VARID(nfid,'baromPressure',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var baromPressure'
      endif
        nf_status = NF_GET_VAR_REAL(nfid,nf_vid,baromPressure)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var baromPressure'
      endif
C
C     Variable        NETCDF Long Name
C      bpMan        "Pressure - Mandatory Level"
C
        nf_status = NF_INQ_VARID(nfid,'bpMan',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var bpMan'
      endif
        nf_status = NF_GET_VAR_REAL(nfid,nf_vid,bpMan)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var bpMan'
      endif
C
C     Variable        NETCDF Long Name
C      bpStd        "Pressure - Standard Level"
C
        nf_status = NF_INQ_VARID(nfid,'bpStd',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var bpStd'
      endif
        nf_status = NF_GET_VAR_REAL(nfid,nf_vid,bpStd)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var bpStd'
      endif
C
C     Variable        NETCDF Long Name
C      bpTerm       "Pressure - Termination"
C
        nf_status = NF_INQ_VARID(nfid,'bpTerm',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var bpTerm'
      endif
        nf_status = NF_GET_VAR_REAL(nfid,nf_vid,bpTerm)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var bpTerm'
      endif
C
C     Variable        NETCDF Long Name
C      bpTrop       "Pressure - Tropopause Level"
C
        nf_status = NF_INQ_VARID(nfid,'bpTrop',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var bpTrop'
      endif
        nf_status = NF_GET_VAR_REAL(nfid,nf_vid,bpTrop)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var bpTrop'
      endif
C
C     Variable        NETCDF Long Name
C      dewPt        "Dew Point Temperature"
C
        nf_status = NF_INQ_VARID(nfid,'dewPt',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var dewPt'
      endif
        nf_status = NF_GET_VAR_REAL(nfid,nf_vid,dewPt)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var dewPt'
      endif
C
C     Variable        NETCDF Long Name
C      direction    "Wind Direction"
C
        nf_status = NF_INQ_VARID(nfid,'direction',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var direction'
      endif
        nf_status = NF_GET_VAR_REAL(nfid,nf_vid,direction)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var direction'
      endif
C
C     Variable        NETCDF Long Name
C      dpMan        "Dew Point Temperature - Mandatory Level"
C
        nf_status = NF_INQ_VARID(nfid,'dpMan',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var dpMan'
      endif
        nf_status = NF_GET_VAR_REAL(nfid,nf_vid,dpMan)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var dpMan'
      endif
C
C     Variable        NETCDF Long Name
C      dpStd        "Dew Point Temperature - Standard Level"
C
        nf_status = NF_INQ_VARID(nfid,'dpStd',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var dpStd'
      endif
        nf_status = NF_GET_VAR_REAL(nfid,nf_vid,dpStd)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var dpStd'
      endif
C
C     Variable        NETCDF Long Name
C      dpTrop       "Dew Point Temperature - Tropopause Level"
C
        nf_status = NF_INQ_VARID(nfid,'dpTrop',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var dpTrop'
      endif
        nf_status = NF_GET_VAR_REAL(nfid,nf_vid,dpTrop)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var dpTrop'
      endif
C
C     Variable        NETCDF Long Name
C      drMan        "Wind Direction - Mandatory Level"
C
        nf_status = NF_INQ_VARID(nfid,'drMan',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var drMan'
      endif
        nf_status = NF_GET_VAR_REAL(nfid,nf_vid,drMan)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var drMan'
      endif
C
C     Variable        NETCDF Long Name
C      drStd        "Wind Direction - Standard Level"
C
        nf_status = NF_INQ_VARID(nfid,'drStd',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var drStd'
      endif
        nf_status = NF_GET_VAR_REAL(nfid,nf_vid,drStd)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var drStd'
      endif
C
C     Variable        NETCDF Long Name
C      elevation    "Station Elevation"
C
        nf_status = NF_INQ_VARID(nfid,'elevation',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var elevation'
      endif
        nf_status = NF_GET_VAR_REAL(nfid,nf_vid,elevation)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var elevation'
      endif
C
C     Variable        NETCDF Long Name
C      geomHeight   "Geometric Height"
C
        nf_status = NF_INQ_VARID(nfid,'geomHeight',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var geomHeight'
      endif
        nf_status = NF_GET_VAR_REAL(nfid,nf_vid,geomHeight)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var geomHeight'
      endif
C
C     Variable        NETCDF Long Name
C      geopHeight   "Geopotential Height"
C
        nf_status = NF_INQ_VARID(nfid,'geopHeight',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var geopHeight'
      endif
        nf_status = NF_GET_VAR_REAL(nfid,nf_vid,geopHeight)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var geopHeight'
      endif
C
C     Variable        NETCDF Long Name
C      ghMan        "Geometric - Mandatory Level"
C
        nf_status = NF_INQ_VARID(nfid,'ghMan',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var ghMan'
      endif
        nf_status = NF_GET_VAR_REAL(nfid,nf_vid,ghMan)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var ghMan'
      endif
C
C     Variable        NETCDF Long Name
C      ghTerm       "Geometric - Termination"
C
        nf_status = NF_INQ_VARID(nfid,'ghTerm',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var ghTerm'
      endif
        nf_status = NF_GET_VAR_REAL(nfid,nf_vid,ghTerm)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var ghTerm'
      endif
C
C     Variable        NETCDF Long Name
C      ghTrop       "Geometric - Tropopause Level"
C
        nf_status = NF_INQ_VARID(nfid,'ghTrop',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var ghTrop'
      endif
        nf_status = NF_GET_VAR_REAL(nfid,nf_vid,ghTrop)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var ghTrop'
      endif
C
C     Variable        NETCDF Long Name
C      gpStd        "Geopotential - Standard Level"
C
        nf_status = NF_INQ_VARID(nfid,'gpStd',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var gpStd'
      endif
        nf_status = NF_GET_VAR_REAL(nfid,nf_vid,gpStd)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var gpStd'
      endif
C
C     Variable        NETCDF Long Name
C      gpTerm       "Geopotential - Termination"
C
        nf_status = NF_INQ_VARID(nfid,'gpTerm',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var gpTerm'
      endif
        nf_status = NF_GET_VAR_REAL(nfid,nf_vid,gpTerm)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var gpTerm'
      endif
C
C     Variable        NETCDF Long Name
C      latitude     "Station Latitude"
C
        nf_status = NF_INQ_VARID(nfid,'latitude',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var latitude'
      endif
        nf_status = NF_GET_VAR_REAL(nfid,nf_vid,latitude)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var latitude'
      endif
C
C     Variable        NETCDF Long Name
C      longitude    "Station Longitude"
C
        nf_status = NF_INQ_VARID(nfid,'longitude',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var longitude'
      endif
        nf_status = NF_GET_VAR_REAL(nfid,nf_vid,longitude)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var longitude'
      endif
C
C     Variable        NETCDF Long Name
C      precipWater  "Precipitable Water"
C
        nf_status = NF_INQ_VARID(nfid,'precipWater',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var precipWater'
      endif
        nf_status = NF_GET_VAR_REAL(nfid,nf_vid,precipWater)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var precipWater'
      endif
C
C     Variable        NETCDF Long Name
C      relHumidity  "Relative Humidity"
C
        nf_status = NF_INQ_VARID(nfid,'relHumidity',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var relHumidity'
      endif
        nf_status = NF_GET_VAR_REAL(nfid,nf_vid,relHumidity)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var relHumidity'
      endif
C
C     Variable        NETCDF Long Name
C      rhMan        "Relative Humidity - Mandatory Level"
C
        nf_status = NF_INQ_VARID(nfid,'rhMan',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var rhMan'
      endif
        nf_status = NF_GET_VAR_REAL(nfid,nf_vid,rhMan)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var rhMan'
      endif
C
C     Variable        NETCDF Long Name
C      rhStd        "Relative Humidity - Standard Level"
C
        nf_status = NF_INQ_VARID(nfid,'rhStd',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var rhStd'
      endif
        nf_status = NF_GET_VAR_REAL(nfid,nf_vid,rhStd)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var rhStd'
      endif
C
C     Variable        NETCDF Long Name
C      riseRate     "Rise Rate"
C
        nf_status = NF_INQ_VARID(nfid,'riseRate',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var riseRate'
      endif
        nf_status = NF_GET_VAR_REAL(nfid,nf_vid,riseRate)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var riseRate'
      endif
C
C     Variable        NETCDF Long Name
C      shear        "Shear"
C
        nf_status = NF_INQ_VARID(nfid,'shear',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var shear'
      endif
        nf_status = NF_GET_VAR_REAL(nfid,nf_vid,shear)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var shear'
      endif
C
C     Variable        NETCDF Long Name
C      shearDir     "Shear Direction"
C
        nf_status = NF_INQ_VARID(nfid,'shearDir',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var shearDir'
      endif
        nf_status = NF_GET_VAR_REAL(nfid,nf_vid,shearDir)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var shearDir'
      endif
C
C     Variable        NETCDF Long Name
C      shearMagX    "Shear Magnitude X-direction"
C
        nf_status = NF_INQ_VARID(nfid,'shearMagX',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var shearMagX'
      endif
        nf_status = NF_GET_VAR_REAL(nfid,nf_vid,shearMagX)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var shearMagX'
      endif
C
C     Variable        NETCDF Long Name
C      shearMagY    "Shear Magnitude Y-direction"
C
        nf_status = NF_INQ_VARID(nfid,'shearMagY',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var shearMagY'
      endif
        nf_status = NF_GET_VAR_REAL(nfid,nf_vid,shearMagY)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var shearMagY'
      endif
C
C     Variable        NETCDF Long Name
C      spMan        "Wind Speed - Mandatory Level"
C
        nf_status = NF_INQ_VARID(nfid,'spMan',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var spMan'
      endif
        nf_status = NF_GET_VAR_REAL(nfid,nf_vid,spMan)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var spMan'
      endif
C
C     Variable        NETCDF Long Name
C      spStd        "Wind Speed - Standard Level"
C
        nf_status = NF_INQ_VARID(nfid,'spStd',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var spStd'
      endif
        nf_status = NF_GET_VAR_REAL(nfid,nf_vid,spStd)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var spStd'
      endif
C
C     Variable        NETCDF Long Name
C      speed        "Wind Speed"
C
        nf_status = NF_INQ_VARID(nfid,'speed',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var speed'
      endif
        nf_status = NF_GET_VAR_REAL(nfid,nf_vid,speed)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var speed'
      endif
C
C     Variable        NETCDF Long Name
C      temperature  "Temperature"
C
        nf_status = NF_INQ_VARID(nfid,'temperature',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var temperature'
      endif
        nf_status = NF_GET_VAR_REAL(nfid,nf_vid,temperature)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var temperature'
      endif
C
C     Variable        NETCDF Long Name
C      tpMan        "Temperature - Mandatory Level"
C
        nf_status = NF_INQ_VARID(nfid,'tpMan',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var tpMan'
      endif
        nf_status = NF_GET_VAR_REAL(nfid,nf_vid,tpMan)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var tpMan'
      endif
C
C     Variable        NETCDF Long Name
C      tpStd        "Temperature - Standard Level"
C
        nf_status = NF_INQ_VARID(nfid,'tpStd',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var tpStd'
      endif
        nf_status = NF_GET_VAR_REAL(nfid,nf_vid,tpStd)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var tpStd'
      endif
C
C     Variable        NETCDF Long Name
C      tpTrop       "Temperature - Tropopause Level"
C
        nf_status = NF_INQ_VARID(nfid,'tpTrop',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var tpTrop'
      endif
        nf_status = NF_GET_VAR_REAL(nfid,nf_vid,tpTrop)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var tpTrop'
      endif
C
C     Variable        NETCDF Long Name
C      vaporPressure"Pressure"
C
        nf_status = NF_INQ_VARID(nfid,'vaporPressure',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var vaporPressure'
      endif
        nf_status = NF_GET_VAR_REAL(nfid,nf_vid,vaporPressure)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var vaporPressure'
      endif
C
C     Variable        NETCDF Long Name
C      velError     "Velocity Error"
C
        nf_status = NF_INQ_VARID(nfid,'velError',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var velError'
      endif
        nf_status = NF_GET_VAR_REAL(nfid,nf_vid,velError)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var velError'
      endif
C
C     Variable        NETCDF Long Name
C      velSound     "Velocity of Sound"
C
        nf_status = NF_INQ_VARID(nfid,'velSound',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var velSound'
      endif
        nf_status = NF_GET_VAR_REAL(nfid,nf_vid,velSound)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var velSound'
      endif

C   Variables of type INT
C
C
C     Variable        NETCDF Long Name
C      editFlag     "Edit Flag"
C
        nf_status = NF_INQ_VARID(nfid,'editFlag',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var editFlag'
      endif
        nf_status = NF_GET_VAR_INT(nfid,nf_vid,editFlag)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var editFlag'
      endif
C
C     Variable        NETCDF Long Name
C      firstInBin
C
        nf_status = NF_INQ_VARID(nfid,'firstInBin',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var firstInBin'
      endif
        nf_status = NF_GET_VAR_INT(nfid,nf_vid,firstInBin)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var firstInBin'
      endif
C
C     Variable        NETCDF Long Name
C      firstOverflow
C
        nf_status = NF_INQ_VARID(nfid,'firstOverflow',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var firstOverflow'
      endif
        nf_status = NF_GET_VAR_INT(nfid,nf_vid,firstOverflow)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var firstOverflow'
      endif
C
C     Variable        NETCDF Long Name
C      globalInventory
C
        nf_status = NF_INQ_VARID(nfid,'globalInventory',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var globalInventory'
      endif
        nf_status = NF_GET_VAR_INT(nfid,nf_vid,globalInventory)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var globalInventory'
      endif
C
C     Variable        NETCDF Long Name
C      indxRefr     "Microwave Index of Refraction"
C
        nf_status = NF_INQ_VARID(nfid,'indxRefr',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var indxRefr'
      endif
        nf_status = NF_GET_VAR_INT(nfid,nf_vid,indxRefr)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var indxRefr'
      endif
C
C     Variable        NETCDF Long Name
C      invTime
C
        nf_status = NF_INQ_VARID(nfid,'invTime',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var invTime'
      endif
        nf_status = NF_GET_VAR_INT(nfid,nf_vid,invTime)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var invTime'
      endif
C
C     Variable        NETCDF Long Name
C      inventory
C
        nf_status = NF_INQ_VARID(nfid,'inventory',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var inventory'
      endif
        nf_status = NF_GET_VAR_INT(nfid,nf_vid,inventory)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var inventory'
      endif
C
C     Variable        NETCDF Long Name
C      irMan        "Microwave Index of Refraction - Mandatory level"
C
        nf_status = NF_INQ_VARID(nfid,'irMan',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var irMan'
      endif
        nf_status = NF_GET_VAR_INT(nfid,nf_vid,irMan)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var irMan'
      endif
C
C     Variable        NETCDF Long Name
C      isOverflow
C
        nf_status = NF_INQ_VARID(nfid,'isOverflow',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var isOverflow'
      endif
        nf_status = NF_GET_VAR_INT(nfid,nf_vid,isOverflow)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var isOverflow'
      endif
C
C     Variable        NETCDF Long Name
C      lastInBin
C
        nf_status = NF_INQ_VARID(nfid,'lastInBin',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var lastInBin'
      endif
        nf_status = NF_GET_VAR_INT(nfid,nf_vid,lastInBin)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var lastInBin'
      endif
C
C     Variable        NETCDF Long Name
C      lastRecord
C
        nf_status = NF_INQ_VARID(nfid,'lastRecord',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var lastRecord'
      endif
        nf_status = NF_GET_VAR_INT(nfid,nf_vid,lastRecord)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var lastRecord'
      endif
C
C     Variable        NETCDF Long Name
C      nStaticIds
C
        nf_status = NF_INQ_VARID(nfid,'nStaticIds',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var nStaticIds'
      endif
        nf_status = NF_GET_VAR_INT(nfid,nf_vid,nStaticIds)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var nStaticIds'
      endif
C
C     Variable        NETCDF Long Name
C      oiMan        "Optical Index of Refraction - Mandatory Level"
C
        nf_status = NF_INQ_VARID(nfid,'oiMan',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var oiMan'
      endif
        nf_status = NF_GET_VAR_INT(nfid,nf_vid,oiMan)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var oiMan'
      endif
C
C     Variable        NETCDF Long Name
C      optIndxRefr  "Optical Index of Refraction"
C
        nf_status = NF_INQ_VARID(nfid,'optIndxRefr',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var optIndxRefr'
      endif
        nf_status = NF_GET_VAR_INT(nfid,nf_vid,optIndxRefr)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var optIndxRefr'
      endif
C
C     Variable        NETCDF Long Name
C      prevRecord
C
        nf_status = NF_INQ_VARID(nfid,'prevRecord',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var prevRecord'
      endif
        nf_status = NF_GET_VAR_INT(nfid,nf_vid,prevRecord)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var prevRecord'
      endif
C
C     Variable        NETCDF Long Name
C      storedObs    "Stored \'Raw\' Profile Observations"
C
        nf_status = NF_INQ_VARID(nfid,'storedObs',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var storedObs'
      endif
        nf_status = NF_GET_VAR_INT(nfid,nf_vid,storedObs)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var storedObs'
      endif

C   Variables of type DOUBLE
C
C
C     Variable        NETCDF Long Name
C      observationTime"Observation Time"
C
        nf_status = NF_INQ_VARID(nfid,'observationTime',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var observationTime'
      endif
        nf_status = NF_GET_VAR_DOUBLE(nfid,nf_vid,observationTime)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var observationTime'
      endif
C
C     Variable        NETCDF Long Name
C      receivedTime "Received Time"
C
        nf_status = NF_INQ_VARID(nfid,'receivedTime',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var receivedTime'
      endif
        nf_status = NF_GET_VAR_DOUBLE(nfid,nf_vid,receivedTime)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var receivedTime'
      endif
C
C     Variable        NETCDF Long Name
C      reportTime   "Report Time"
C
        nf_status = NF_INQ_VARID(nfid,'reportTime',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var reportTime'
      endif
        nf_status = NF_GET_VAR_DOUBLE(nfid,nf_vid,reportTime)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var reportTime'
      endif

C   Variables of type CHAR
C
C
C     Variable        NETCDF Long Name
C      dataProvider "Local data provider"
C
        nf_status = NF_INQ_VARID(nfid,'dataProvider',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var dataProvider'
      endif
        nf_status = NF_GET_VAR_TEXT(nfid,nf_vid,dataProvider)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var dataProvider'
      endif
C
C     Variable        NETCDF Long Name
C      providerId   "Data Provider station Id"
C
        nf_status = NF_INQ_VARID(nfid,'providerId',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var providerId'
      endif
        nf_status = NF_GET_VAR_TEXT(nfid,nf_vid,providerId)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var providerId'
      endif
C
C     Variable        NETCDF Long Name
C      staticIds
C
        nf_status = NF_INQ_VARID(nfid,'staticIds',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var staticIds'
      endif
        nf_status = NF_GET_VAR_TEXT(nfid,nf_vid,staticIds)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var staticIds'
      endif
C
C     Variable        NETCDF Long Name
C      stationName  "alphanumeric station name"
C
        nf_status = NF_INQ_VARID(nfid,'stationName',nf_vid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var stationName'
      endif
        nf_status = NF_GET_VAR_TEXT(nfid,nf_vid,stationName)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'in var stationName'
      endif

      nf_status = nf_close(nfid)
      if(nf_status.ne.NF_NOERR) then
        print *, NF_STRERROR(nf_status)
        print *,'nf_close'
      endif

      return
      end


subroutine updbnddps(flupd     ,dstep     ,j         ,nmmaxj    ,kmax      , &
               & nsrc      ,qu        ,qv        ,discum    ,gdp       )
!----- GPL ---------------------------------------------------------------------
!
!  Copyright (C)  Stichting Deltares, 2011-2016.
!
!  This program is free software: you can redistribute it and/or modify
!  it under the terms of the GNU General Public License as published by
!  the Free Software Foundation version 3.
!
!  This program is distributed in the hope that it will be useful,
!  but WITHOUT ANY WARRANTY; without even the implied warranty of
!  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
!  GNU General Public License for more details.
!
!  You should have received a copy of the GNU General Public License
!  along with this program.  If not, see <http://www.gnu.org/licenses/>.
!
!  contact: delft3d.support@deltares.nl
!  Stichting Deltares
!  P.O. Box 177
!  2600 MH Delft, The Netherlands
!
!  All indications and logos of, and references to, "Delft3D" and "Deltares"
!  are registered trademarks of Stichting Deltares, and remain the property of
!  Stichting Deltares. All rights reserved.
!
!-------------------------------------------------------------------------------
!  $Id: updbnddps.f90 5717 2016-01-12 11:35:24Z mourits $
!  $HeadURL: https://svn.oss.deltares.nl/repos/delft3d/tags/6686/src/engines_gpl/flow2d3d/packages/io/src/output/updbnddps.f90 $
!!--description-----------------------------------------------------------------
!
!    Function: Update cummelative values for discharges QU, QV
!              and DISCUM
!              DSTEP in 1 / (twice the time step interval in
!              equivalents of DT) or DSTEP = 0. to initialize
! Method used:
!
!!--pseudo code and references--------------------------------------------------
! NONE
!!--declarations----------------------------------------------------------------
    use precision
    use globaldata
    !
    implicit none
    !
    type(globdat),target :: gdp
    !
    ! The following list of pointer parameters is used to point inside the gdp structure
    !
!
! Global variables
!
    integer                            , intent(in)  :: j      !!  Begin pointer for arrays which have been transformed into 1D arrays. Due to the shift in the 2nd (M-) index, JSTART = -2*NMAX + 1
    integer                            , intent(in)  :: kmax   !  Description and declaration in esm_alloc_int.f90
    integer                            , intent(in)  :: nmmaxj !  Description and declaration in dimens.igs
    integer                            , intent(in)  :: nsrc   !  Description and declaration in esm_alloc_int.f90
    logical                            , intent(in)  :: flupd  !!  Flag to update (true) or initialize (false) the discharge arrays
    real(fp)                           , intent(in)  :: dstep  !!  1. / total number of timesteps (interval to write comm. file)
    real(fp), dimension(gdp%d%nmlb:gdp%d%nmub, kmax) :: qu     !  Description and declaration in esm_alloc_real.f90
    real(fp), dimension(gdp%d%nmlb:gdp%d%nmub, kmax) :: qv     !  Description and declaration in esm_alloc_real.f90
    real(fp), dimension(nsrc)                        :: discum !  Description and declaration in esm_alloc_real.f90
!
! Local variables
!
    integer :: k  ! Loop counter 1,KMAX
    integer :: n  ! Loop counter 1,NSRC
    integer :: nm ! Loop counter J,NMMAXJ
!
!! executable statements -------------------------------------------------------
!
    ! For timestep NST = ITCOMC before writing to communication file
    ! because QU, QV and DISCUM are calculated every half DT.
    ! devide QU, QV and DISCUM by (2 * ITCOMI). here DSTEP=1/(2*ITCOMI)
    !
    if (flupd) then
       do nm = j, nmmaxj
          do k = 1, kmax
             qu(nm, k) = qu(nm,k) * dstep
             qv(nm, k) = qv(nm,k) * dstep
          enddo
       enddo
       do n = 1, nsrc
          discum(n) = discum(n) * dstep
       enddo
    else
       !
       ! At timestep NST = ITCOMF - ITCOMI or after writing to commu-
       ! cation file there will be a reset of QU, QV and DISCUM to 0.
       !
       do nm = j, nmmaxj
          do k = 1, kmax
             qu(nm, k) = 0.0_fp
             qv(nm, k) = 0.0_fp
          enddo
       enddo
       do n = 1, nsrc
          discum(n) = 0.0_fp
       enddo
    endif
end subroutine updbnddps


C
C
C
C
C
      SUBROUTINE SET_REYNOLDS(OMEGA, VRELCON, VRELC, VRELP, NDIMWV,
     & ACTIVE_ELEM, PI, TIME, TRAMP, TSTART, INT, ISTATC, NODYN,
     & NPERIOD, NUMEL, NWVPASS)
C
C ----------------------------------------------------------------------
C Routine to set control variables for Cd = f(Re)
C ----------------------------------------------------------------------
C

      IMPLICIT NONE
C
C COMMON variables
C
      INTEGER, intent(in) :: INT
      INTEGER, intent(in) :: ISTATC
      integer, intent(in) :: NDIMWV
      INTEGER, intent(in) :: NODYN
      INTEGER, intent(inout) :: NPERIOD
      INTEGER, intent(in) :: NUMEL
      INTEGER, intent(out) :: NWVPASS
      real(8), intent(in) :: PI
      REAL(8), intent(in) :: TIME
      REAL(8), intent(in) :: TRAMP
      REAL(8), intent(in) :: TSTART
      integer, intent(in), dimension(numel,2) :: ACTIVE_ELEM
      REAL(8) , DIMENSION(NDIMWV) :: OMEGA
      REAL(8) , DIMENSION(INT,NUMEL) :: VRELC
      REAL(8) , DIMENSION(5) :: VRELCON
      REAL(8) , DIMENSION(INT,NUMEL) :: VRELP

      INTENT (IN) OMEGA , VRELC , VRELP
      INTENT (INOUT) VRELCON
C Local variables
      REAL(8) :: DABS
      REAL :: FLOAT
      INTEGER :: I
      INTEGER :: J
      INTEGER :: K
      REAL(8) :: WAVPERD

C
      IF (NODYN.EQ.1) THEN                       ! Static analysis
        NWVPASS = 0
      ELSE IF (NODYN.EQ.0.AND.ISTATC.EQ.1) THEN  ! Quasi-static analysis
        NWVPASS = 0
      ELSE                                       ! Dynamic analysis
        WAVPERD = (2.0D0 * PI) / OMEGA(1)
C
C...... Check for new wave period
C
        IF (TIME > (TSTART + TRAMP + (NPERIOD * WAVPERD))) THEN
          NWVPASS = 0
          NPERIOD = NPERIOD + 1
          DO I = 1,4                               ! Swap convergence
            VRELCON(6-I) = VRELCON(5-I)            ! check from previous
          END DO                                   ! 4 wace periods
          VRELCON(1) = 0.0D0
          DO J = 1,NUMEL                           ! Calculate current
C                                                  ! convergence check
C.......... Check is this an active element
C
            IF(ACTIVE_ELEM(J, 2) /= 1)CYCLE

            DO K=1,INT
              IF (DABS(VRELC(K,J)) > 1.D-20) THEN
                VRELCON(1) = VRELCON(1) +
     &                     DABS((VRELC(K,J) - VRELP(K,J)) / VRELC(K,J))
              END IF
            END DO
          END DO
          VRELCON(1) = VRELCON(1) / FLOAT(NUMEL * INT)
          VRELCON(1) = VRELCON(1) * 100.0           ! In percent
        END IF
      END IF
C
      RETURN
C
      END SUBROUTINE SET_REYNOLDS


      subroutine move_particle(ipart, spacing_subst,
     2     local_pos, local_spacing,
     3     too_many_jumps, coord_flag)
!***********************************************************************
!  Copyright, 2004,  The  Regents  of the  University of California.
!  This program was prepared by the Regents of the University of
!  California at Los Alamos National Laboratory (the University) under
!  contract No. W-7405-ENG-36 with the U.S. Department of Energy (DOE).
!  All rights in the program are reserved by the DOE and the University.
!  Permission is granted to the public to copy and use this software
!  without charge, provided that this Notice and any statement of
!  authorship are reproduced on all copies. Neither the U.S. Government
!  nor the University makes any warranty, express or implied, or
!  assumes any liability or responsibility for the use of this software.
!**********************************************************************
!D1
!D1 PURPOSE
!D1
!D1 Perform random walk shift of particle for dispersion between cells
!D1 in the streamline particle tracking algorithm.
!D1
!**********************************************************************
!D2
!D2 REVISION HISTORY
!D2
!D2 FEHM Version 2.10 [10086-STN-2.10-00]
!D2
!D2 Initial implementation: ?, Programmer: ?
!D2
!D2 $Log:   /pvcs.config/fehm90/src/move_particle.f_a  $
!D2
!D2    Rev 2.5   06 Jan 2004 10:43:30   pvcs
!D2 FEHM Version 2.21, STN 10086-2.21-00, Qualified October 2003
!D2
!D2    Rev 2.4   29 Jan 2003 09:10:28   pvcs
!D2 FEHM Version 2.20, STN 10086-2.20-00
!D2
!D2    Rev 2.3   14 Nov 2001 13:11:04   pvcs
!D2 FEHM Version 2.12, STN 10086-2.12-00
!D2
!D2    Rev 2.2   06 Jun 2001 13:31:08   pvcs
!D2 FEHM Version 2.11, STN 10086-2.11-00
!D2
!D2    Rev 2.1   30 Nov 2000 12:05:14   pvcs
!D2 FEHM Version 2.10, STN 10086-2.10-00
!D2
!**********************************************************************
!D3
!D3 REQUIREMENTS TRACEABILITY
!D3
!D3 2.3.5 Cell-based particle-tracking module
!D3
!**********************************************************************
!D4
!D4 SPECIAL COMMENTS AND REFERENCES
!D4
!D4 Requirements from SDN: 10086-RD-2.20-00
!D4   SOFTWARE REQUIREMENTS DOCUMENT (RD) for the
!D4   FEHM Application Version 2.20
!D4
!**********************************************************************

      use comsptr
      use comdti
      use comai
      use combi
      use comdi
      implicit none

      integer maxjumps
      parameter(maxjumps = 10)
      integer maxjumps1
      parameter(maxjumps1 = maxjumps +1)
      integer nodewrite(maxjumps1)
      integer ipart, current_node, current_model, transflag
      integer ijump, coord_flag
      logical done
      real*8 spacing_subst(0:*)
      real*8 nondim, local_pos, local_spacing
      logical too_many_jumps

      too_many_jumps = .false.
      current_node = ijkv(ipart)
      if(current_node.ne.0) then
         current_model = itrc(ijkv(ipart))
         transflag = tprpflag(current_model)
      else
         transflag = 0
      end if
      if(transflag.eq.2.or.transflag.eq.4.or.transflag.eq.13.or.
     &     transflag.eq.14) then
         if(coord_flag.eq.1) ijkvs(ipart) = ijkv(ipart)
         ic_new(ipart) = 0
c     Only move the particle if it hasn't already left the system
c     BAR - 12-4-98

         if(ijkv(ipart).ne.0) then
c            if(irray(ijkv(ipart),0).gt.0) then
               done = .false.
               ijump = 0
               nodewrite = 0
c     do while loop handles the case of particles that move
c     more than one grid cell in the x direction
               do while(.not.done)
                  ijump = ijump + 1
                  nodewrite(ijump) = ijkv(ipart)
                  if(ijump.gt.maxjumps) then
                     call write_error(coord_flag)
                     too_many_jumps = .true.
                     done = .true.
                     goto 1000
c                     stop
                  end if
                  nondim = local_pos/local_spacing
                  if(nondim.ge.1.) then
                     if(irray(ijkv(ipart), coord_flag).ne.0) then
c     Move particle forward to adjacent cell in x direction
                        ic_new(ipart)=ic_new(ipart)+1
                        ijkv(ipart)=irray(ijkv(ipart), coord_flag)
                        local_pos=local_pos-local_spacing
                        local_spacing = spacing_subst(ijkv(ipart))
                     else
c     Reflect particle back in x direction
                        ic_new(ipart)=ic_new(ipart)+1
                        local_pos=2*local_spacing-local_pos
                     end if
                  elseif(nondim.le.0.) then
                     if(irray(ijkv(ipart),-coord_flag).ne.0) then
c     Move particle backward to adjacent cell in x direction
                        ic_new(ipart)=ic_new(ipart)+1
                        ijkv(ipart)=irray(ijkv(ipart),-coord_flag)
                        local_pos=local_pos+
     2                       spacing_subst(ijkv(ipart))
                        local_spacing = spacing_subst(ijkv(ipart))
                     else
c     Reflect particle forward in x direction
                        ic_new(ipart)=ic_new(ipart)+1
                        local_pos=-local_pos
                     end if
                  else
                     done = .true.
                  end if
c                  if(irray(ijkv(ipart),0).lt.0) done=.true.

c     Internal subroutine to determine if particle has previously
c     or just now reached a btc zone

                  call seek_btczone(ipart, ijkv(ipart))
 1000             continue

               end do

c     Node may have changed, need to change ddyv and ddzv
               if(coord_flag.eq.1) then
                  ddyv(ipart) = ddy(ijkv(ipart))
                  ddzv(ipart) = ddz(ijkv(ipart))
               elseif(coord_flag.eq.2) then
                  ddxv(ipart) = ddx(ijkv(ipart))
                  ddzv(ipart) = ddz(ijkv(ipart))
               elseif(coord_flag.eq.3) then
                  ddxv(ipart) = ddx(ijkv(ipart))
                  ddyv(ipart) = ddy(ijkv(ipart))
               end if

c            end if
         end if
      end if

      return

      contains

      subroutine write_error(idirection)
      implicit none
      integer idirection

      if(iptty.gt.0) then
c         write(iptty,*) 'Fatal Error in ptrac3'
c         write(iptty,*) 'Particle has attempted to jump'
c         write(iptty,*) 'more than ',maxjumps,'cells'
c         write(iptty,*) 'in this random walk time step.'
c         write(iptty,*) 'Reduce particle tracking time step.'
c         write(iptty,*) 'Particle number', ipart
         if(idirection.eq.1) then
c            write(iptty,*)
c     2'Warning - too many jumps in x for particle', ipart,
c     3'cell number',ijkv(ipart)
c            write(iptty,*) 'Fatal direction for jump: x'
         elseif(idirection.eq.2) then
c            write(iptty,*)
c     2'Warning - too many jumps in y for particle', ipart,
c     3'cell number',ijkv(ipart)
c            write(iptty,*) 'Fatal direction for jump: y'
         else
c            write(iptty,*)
c     2'Warning - too many jumps in z for particle', ipart,
c     3'cell number',ijkv(ipart)
c            write(iptty,*) 'Fatal direction for jump: z'
         end if
c         write(iptty,*) 'Final cell number:',ijkv(ipart)
c         write(iptty,*) 'Final relative x value:',x2(ipart)
c         write(iptty,*) 'Final relative y value:',y2(ipart)
c         write(iptty,*) 'Final relative z value:',z2(ipart)
c         write(iptty,*) 'Node number sequence for jumps:'
c         write(iptty,2100) nodewrite
      end if
      if(iout.gt.0) then
c         write(iout,*) 'Fatal Error in ptrac3'
c         write(iout,*) 'Particle has attempted to jump'
c         write(iout,*) 'more than ',maxjumps,'cells'
c         write(iout,*) 'in this random walk time step.'
c         write(iout,*) 'Reduce particle tracking time step.'
c         write(iout,*) 'Particle number', ipart
         if(idirection.eq.1) then
c            write(iout,*)
c     2'Warning - too many jumps in x for particle', ipart,
c     3'cell number',ijkv(ipart)
c            write(iout,*) 'Fatal direction for jump: x'
         elseif(idirection.eq.2) then
c            write(iout,*)
c     2'Warning - too many jumps in y for particle', ipart,
c     3'cell number',ijkv(ipart)
c            write(iout,*) 'Fatal direction for jump: y'
         else
c            write(iout,*)
c     2'Warning - too many jumps in z for particle', ipart,
c     3'cell number',ijkv(ipart)
c            write(iout,*) 'Fatal direction for jump: z'
         end if
c         write(iout,*) 'Final cell number:',ijkv(ipart)
c         write(iout,*) 'Final relative x value:',x2(ipart)
c         write(iout,*) 'Final relative y value:',y2(ipart)
c         write(iout,*) 'Final relative z value:',z2(ipart)
c         write(iout,*) 'Node number sequence for jumps:'
c         write(iout,2100) nodewrite
      end if
 2100 format(15i8)
      return
      end subroutine write_error

      end subroutine move_particle