!*------------------------------------------------------------------------------
!*  Standard Disclaimer
!*
!*  Forecast Systems Laboratory
!*  NOAA/OAR/ERL/FSL
!*  325 Broadway
!*  Boulder, CO     80303
!*
!*  AVIATION DIVISION
!*  ADVANCED COMPUTING BRANCH
!*  SMS/NNT Version: 2.0.0 
!*
!*  This software and its documentation are in the public domain and
!*  are furnished "as is".  The United States government, its 
!*  instrumentalities, officers, employees, and agents make no 
!*  warranty, express or implied, as to the usefulness of the software 
!*  and documentation for any purpose.  They assume no 
!*  responsibility (1) for the use of the software and documentation; 
!*  or (2) to provide technical support to users.
!* 
!*  Permission to use, copy, modify, and distribute this software is
!*  hereby granted, provided that this disclaimer notice appears in 
!*  all copies.  All modifications to this software must be clearly
!*  documented, and are solely the responsibility of the agent making
!*  the modification.  If significant modifications or enhancements
!*  are made to this software, the SMS Development team
!*  (sms-info@fsl.noaa.gov) should be notified.
!*
!*----------------------------------------------------------------------------
!*
!*  WRF NetCDF I/O
!   Author:  Jacques Middlecoff jacquesm@fsl.noaa.gov
!*  Date:    October 6, 2000
!*
!*----------------------------------------------------------------------------

  use wrf_data
  use ext_ncd_support_routines
  implicit none
  include 'wrf_status_codes.h'
  include 'netcdf.inc'
  integer               ,intent(in)     :: DataHandle
  character*(*)         ,intent(in)     :: Element
  character*(*)         ,intent(in)     :: DateStr
  character*(*)         ,intent(in)     :: Var
  TYPE_DATA
  TYPE_COUNT
  integer               ,intent(out)    :: Status
  type(wrf_data_handle) ,pointer        :: DH
  character (VarNameLen)                :: VarName
  character (40+len(Element))           :: Name
  integer                               :: stat
  integer                               :: stat2
  integer               ,allocatable    :: Buffer(:)
  integer                               :: i
  integer                               :: VDims (2)
  integer                               :: VStart(2)
  integer                               :: VCount(2)
  integer                               :: NVar
  integer                               :: TimeIndex
  integer                               :: NCID

  VarName = Var
  call DateCheck(DateStr,Status)
  if(Status /= WRF_NO_ERR) then
    write(msg,*) &
'Warning DATE STRING ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ 
    call wrf_debug ( WARN , msg)
    return
  endif
  call GetDH(DataHandle,DH,Status)
  if(Status /= WRF_NO_ERR) then
    write(msg,*) &
'Warning Status = ',Status,' in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
    call wrf_debug ( WARN , msg)
    return
  endif
  NCID = DH%NCID
  call GetName(Element, VarName, Name, Status)
  if(Status /= WRF_NO_ERR) then
    write(msg,*) &
'Warning Status = ',Status,' in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
    call wrf_debug ( WARN , msg)
    return
  endif
  if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
    Status = WRF_WARN_FILE_NOT_OPENED  
    write(msg,*) &
'Warning FILE NOT OPENED in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
    call wrf_debug ( WARN , msg)
  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
    Status = WRF_WARN_WRITE_RONLY_FILE  
    write(msg,*) &
'Warning WRITE READ ONLY FILE in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ 
    call wrf_debug ( WARN , msg)
  elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
    if(LENGTH < 1) then
      Status = WRF_WARN_ZERO_LENGTH_PUT  
      return
    endif
    do NVar=1,MaxVars
      if(DH%MDVarNames(NVar) == Name) then
        Status = WRF_WARN_2DRYRUNS_1VARIABLE  
        return
      elseif(DH%MDVarNames(NVar) == NO_NAME) then
        DH%MDVarNames(NVar) = Name
        exit
      elseif(NVar == MaxVars) then
        Status = WRF_WARN_TOO_MANY_VARIABLES  
        write(msg,*) &
'Warning TOO MANY VARIABLES in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ 
        call wrf_debug ( WARN , msg)
        return
      endif
    enddo
    do i=1,MaxDims
      if(DH%DimLengths(i) == LENGTH) then
        exit
      elseif(DH%DimLengths(i) == NO_DIM) then
        stat = NF_DEF_DIM(NCID,DH%DimNames(i),LENGTH,DH%DimIDs(i))
        call netcdf_err(stat,Status)
        if(Status /= WRF_NO_ERR) then
          write(msg,*) &
'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element
          call wrf_debug ( WARN , msg)
          return
        endif
        DH%DimLengths(i) = LENGTH
        exit
      elseif(i == MaxDims) then
        Status = WRF_WARN_TOO_MANY_DIMS  
        write(msg,*) &
'Warning TOO MANY DIMENSIONS in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ 
        call wrf_debug ( WARN , msg)
        return
      endif
    enddo
    DH%MDVarDimLens(NVar) = LENGTH
    VDims(1) = DH%DimIDs(i)
    VDims(2) = DH%DimUnlimID
    stat = NF_DEF_VAR(NCID,Name,NF_TYPE,2,VDims,DH%MDVarIDs(NVar))
    call netcdf_err(stat,Status)
    if(Status /= WRF_NO_ERR) then
      write(msg,*) &
'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element
      call wrf_debug ( WARN , msg)
      return
    endif
  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
    do NVar=1,MaxVars
      if(DH%MDVarNames(NVar) == Name) then
        exit
      elseif(DH%MDVarNames(NVar) == NO_NAME) then
        Status = WRF_WARN_MD_NF  
        write(msg,*) &
'Warning METADATA NOT FOUND in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
        call wrf_debug ( WARN , msg)
        return
      elseif(NVar == MaxVars) then
        Status = WRF_WARN_TOO_MANY_VARIABLES  
        write(msg,*) &
'Warning TOO MANY VARIABLES in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ 
        call wrf_debug ( WARN , msg)
        return
      endif
    enddo
    if(LENGTH > DH%MDVarDimLens(NVar)) then
      Status = WRF_WARN_COUNT_TOO_LONG 
      write(msg,*) &
'Warning COUNT TOO LONG in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
      call wrf_debug ( WARN , msg)
      return
    elseif(LENGTH < 1) then
      Status = WRF_WARN_ZERO_LENGTH_PUT  
      write(msg,*) &
'Warning ZERO LENGTH PUT in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
      call wrf_debug ( WARN , msg)
      return
    endif
    call GetTimeIndex('write',DataHandle,DateStr,TimeIndex,Status)
    if(Status /= WRF_NO_ERR) then
      write(msg,*) &
'Warning in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
      call wrf_debug ( WARN , msg)
      return
    endif
    VStart(1) = 1
    VStart(2) = TimeIndex
    VCount(1) = LENGTH
    VCount(2) = 1
#ifdef LOG
      allocate(Buffer(LENGTH), STAT=stat)
      if(stat/= 0) then
        Status = WRF_ERR_FATAL_ALLOCATION_ERROR 
        write(msg,*) &
'Fatal ALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
        call wrf_debug ( FATAL , msg)
        return
      endif
      do i=1,Count
        if(data(i)) then
           Buffer(i)=1
        else
           Buffer(i)=0
        endif
      enddo
      stat = NF_ROUTINE (NCID,DH%MDVarIDs(NVar),VStart,VCount,Buffer)
      deallocate(Buffer, STAT=stat2)
      if(stat2/= 0) then
        Status = WRF_ERR_FATAL_DEALLOCATION_ERR 
        write(msg,*) &
'Fatal DEALLOCATION ERROR in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
        call wrf_debug ( FATAL , msg)
        return
      endif
#else
      stat = NF_ROUTINE (NCID,DH%MDVarIDs(NVar),VStart,VCount,Data)
#endif
    call netcdf_err(stat,Status)
    if(Status /= WRF_NO_ERR) then
      write(msg,*) &
'NetCDF error in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__,' Element ',Element
      call wrf_debug ( WARN , msg)
      return
    endif
  else
    Status = WRF_ERR_FATAL_BAD_FILE_STATUS
    write(msg,*) &
'Fatal error BAD FILE STATUS in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__ 
    call wrf_debug ( FATAL , msg)
    return
  endif
  return