/wrfv2_fire/external/io_phdf5/wrf-phdf5.F90

Large files files are truncated, but you can click here to view the full file

!/***************************************************************************
!* The HDF5 WRF IO module was written by the the HDF Group at NCSA, the     *
!* National Center for Supercomputing Applications.                         *
!*     HDF Group                                                            *
!*     National Center for Supercomputing Applications                      *
!*     University of Illinois at Urbana-Champaign                           *
!*     605 E. Springfield, Champaign IL 61820                               *
!*     http://hdf.ncsa.uiuc.edu/                                            *
!*                                                                          *
!* Copyright 2004 by the Board of Trustees, University of Illinois,         *
!*                                                                          *
!* Redistribution or use of this IO module, with or without modification,   *
!* is permitted for any purpose, including commercial  purposes.            *
!*                                                                          *
!* This software is an unsupported prototype.  Use at your own risk.        *
!*     http://hdf.ncsa.uiuc.edu/apps/WRF-ROMS                               *
!*                                                                          *
!* This work was funded by the MEAD expedition at the National Center       *
!* for Supercomputing Applications, NCSA.  For more information see:        *
!*     http://www.ncsa.uiuc.edu/expeditions/MEAD                            *
!*                                                                          *
!*                                                                          *
!****************************************************************************/


subroutine HDF5IOWRITE(DataHandle,Comm,DateStr,Length,DomainStart,DomainEnd &
     ,PatchStart,PatchEnd,MemoryOrder &
     ,WrfDType,FieldType,groupID,TimeIndex &
     ,DimRank ,DatasetName,XField,Status)

  use wrf_phdf5_data
  use ext_phdf5_support_routines
  use HDF5
  implicit none
  include 'mpif.h'
  include 'wrf_status_codes.h'

  integer                     ,intent(in)     :: DataHandle
  integer                     ,intent(inout)  :: Comm
  character*(*)               ,intent(in)     :: DateStr
  integer,dimension(NVarDims) ,intent(in)     :: Length

  integer,dimension(NVarDims) ,intent(in)     :: DomainStart
  integer,dimension(NVarDims) ,intent(in)     :: DomainEnd
  integer,dimension(NVarDims) ,intent(in)     :: PatchStart
  integer,dimension(NVarDims) ,intent(in)     :: PatchEnd

  character*(*)               ,intent(in)     :: MemoryOrder

  integer                     ,intent(in)     :: WrfDType
  integer(hid_t)              ,intent(in)     :: FieldType
  integer(hid_t)              ,intent(in)     :: groupID
  integer                     ,intent(in)     :: TimeIndex

  integer,dimension(*)        ,intent(in)     :: DimRank
  character (*)               ,intent(in)     :: DatasetName
  integer,dimension(*)        ,intent(inout)  :: XField
  integer                     ,intent(out)    :: Status

  integer(hid_t)                              :: dset_id
  integer                                     :: NDim
  integer,dimension(NVarDims)                 :: VStart
  integer,dimension(NVarDims)                 :: VCount
  character (3)                               :: Mem0
  character (3)                               :: UCMem0
  type(wrf_phdf5_data_handle) ,pointer         :: DH

  ! attribute defination
  integer(hid_t)                              :: dimaspace_id  ! DimRank dataspace id
  integer(hid_t)                              :: dimattr_id    ! DimRank attribute id
  integer(hsize_t) ,dimension(1)              :: dim_space
  INTEGER(HID_T)                              :: dspace_id     ! Raw Data memory Dataspace id
  INTEGER(HID_T)                              :: fspace_id     ! Raw Data file Dataspace id
  INTEGER(HID_T)                              :: crp_list      ! chunk  identifier
  integer(hid_t)                              :: h5_atypeid    ! for fieldtype,memorder attribute
  integer(hid_t)                              :: h5_aspaceid   ! for fieldtype,memorder  
  integer(hid_t)                              :: h5_attrid     ! for fieldtype,memorder
  integer(hsize_t), dimension(7)              :: adata_dims
  integer                                     :: routine_atype


  integer,          dimension(:),allocatable  :: dimrank_data

  INTEGER(HSIZE_T), dimension(:),allocatable  :: dims  ! Dataset dimensions
  INTEGER(HSIZE_T), dimension(:),allocatable  :: sizes ! Dataset dimensions
  INTEGER(HSIZE_T), dimension(:),allocatable  :: chunk_dims 
  INTEGER(HSIZE_T), dimension(:),allocatable  :: hdf5_maxdims
  INTEGER(HSIZE_T), dimension(:),allocatable  :: offset 
  INTEGER(HSIZE_T), dimension(:),allocatable  :: count  
  INTEGER(HSIZE_T), DIMENSION(7)              :: dimsfi
  integer                                     :: hdf5err
  integer                                     :: i,j
  integer(size_t)                             :: dsetsize

  ! FOR PARALLEL IO
  integer(hid_t)                              :: xfer_list
  logical                                     :: no_par


  ! get the handle 
  call GetDH(DataHandle,DH,Status)
  if(Status /= WRF_NO_ERR) then
     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
     call wrf_debug ( WARN , msg) 
     return
  endif

  ! get the rank of the dimension
  call GetDim(MemoryOrder,NDim,Status)
  if(Status /= WRF_NO_ERR) then
     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
     call wrf_debug ( WARN , msg) 
     return
  endif

  ! If patch is equal to domain, the parallel is not necessary, sequential is used.
  ! In this version, we haven't implemented this yet.
  ! We use no_par to check whether we can use compact data storage.
  no_par = .TRUE.
  do i = 1,NDim
     if((PatchStart(i)/=DomainStart(i)).or.(PatchEnd(i)/=DomainEnd(i))) then
        no_par = .FALSE.
        exit
     endif
  enddo

  ! change the different Memory Order to XYZ for patch and domain
  if(MemoryOrder.NE.'0') then
     call ExtOrder(MemoryOrder,PatchStart,Status)
     call ExtOrder(MemoryOrder,PatchEnd,Status)
     call ExtOrder(MemoryOrder,DomainStart,Status)
     call ExtOrder(MemoryOrder,DomainEnd,Status)
  endif

  ! allocating memory for dynamic arrays; 
  ! since the time step is always 1, we may ignore the fourth
  ! dimension time; now keep it to make it consistent with sequential version
  allocate(dims(NDim+1))
  allocate(count(NDim+1))
  allocate(offset(NDim+1))
  allocate(sizes(NDim+1))


  ! arrange offset, count for each hyperslab
  dims(1:NDim)   = DomainEnd(1:NDim) - DomainStart(1:NDim) + 1
  dims(NDim+1)   = 1

  count(NDim+1)  = 1
  count(1:NDim)  = Length(1:NDim)

  offset(NDim+1) = 0
  offset(1:NDim) = PatchStart(1:NDim) - 1


  ! allocate the dataspace to write hyperslab data

  dimsfi = 0
  do i = 1, NDim + 1
     dimsfi(i) = count(i)
  enddo

  ! create the memory space id
  call h5screate_simple_f(NDim+1,count,dspace_id,hdf5err,count)
  if(hdf5err.lt.0) then
     Status =  WRF_HDF5_ERR_DATASPACE
     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
     call wrf_debug ( WARN , msg) 
     deallocate(dims)
     deallocate(count)
     deallocate(offset)
     deallocate(sizes)
     return
  endif


  ! create file space
  call h5screate_simple_f(NDim+1,dims,fspace_id,hdf5err,dims)
  if(hdf5err.lt.0) then        
     Status =  WRF_HDF5_ERR_DATASPACE
     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
     call wrf_debug ( WARN , msg) 
     deallocate(dims)
     deallocate(count)
     deallocate(offset)
     deallocate(sizes)
     return
  endif

  ! compact storage when the patch is equal to the whole domain
  ! calculate the non-decomposed dataset size

  call h5tget_size_f(FieldType,dsetsize,hdf5err)
  if(hdf5err.lt.0) then
     Status = WRF_HDF5_ERR_DATATYPE
     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
     call wrf_debug ( WARN , msg) 
     deallocate(dims)
     deallocate(count)
     deallocate(offset)
     deallocate(sizes)
     return
  endif

  do i =1,NDim
     dsetsize = dsetsize*dims(i)
  enddo
  if(no_par.and.(dsetsize.le.CompDsetSize)) then
     call h5pcreate_f(H5P_DATASET_CREATE_F,crp_list,hdf5err)
     if(hdf5err.lt.0) then
        Status =  WRF_HDF5_ERR_PROPERTY_LIST
        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
        call wrf_debug ( WARN , msg) 
        deallocate(dims)
        deallocate(count)
        deallocate(offset)
        deallocate(sizes)
        return
     endif
     call h5pset_layout_f(crp_list,0,hdf5err)
     if(hdf5err.lt.0) then
        Status =  WRF_HDF5_ERR_PROPERTY_LIST
        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
        call wrf_debug ( WARN , msg) 
        deallocate(dims)
        deallocate(count)
        deallocate(offset)
        deallocate(sizes)
        return
     endif
     call h5dcreate_f(DH%TgroupIDs(TimeIndex),DatasetName,FieldType,fspace_id,dset_id,&
          hdf5err,crp_list)
     call h5pclose_f(crp_list,hdf5err)
  else
     call h5dcreate_f(DH%TgroupIDs(TimeIndex),DatasetName,FieldType,fspace_id,dset_id,hdf5err)
  endif

  if(hdf5err.lt.0) then
     Status =  WRF_HDF5_ERR_DATASET_CREATE 
     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
     call wrf_debug ( WARN , msg) 
     deallocate(dims)
     deallocate(count)
     deallocate(offset)
     deallocate(sizes)
     return
  endif

  ! select the correct hyperslab for file space id
  CALL h5sselect_hyperslab_f(fspace_id, H5S_SELECT_SET_F, offset, count &
       ,hdf5err) 
  if(hdf5err.lt.0) then
     Status =  WRF_HDF5_ERR_DATASET_GENERAL
     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
     call wrf_debug ( WARN , msg) 
     deallocate(dims)
     deallocate(count)
     deallocate(offset)
     deallocate(sizes)
     return
  endif

  ! Create property list for collective dataset write
  CALL h5pcreate_f(H5P_DATASET_XFER_F, xfer_list, hdf5err)
  if(hdf5err.lt.0) then
     Status =  WRF_HDF5_ERR_PROPERTY_LIST
     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
     call wrf_debug ( WARN , msg) 
     deallocate(dims)
     deallocate(count)
     deallocate(offset)
     deallocate(sizes)
     return
  endif

  CALL h5pset_dxpl_mpio_f(xfer_list, H5FD_MPIO_COLLECTIVE_F&
       ,hdf5err)
  if(hdf5err.lt.0) then
     Status =  WRF_HDF5_ERR_PROPERTY_LIST
     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
     call wrf_debug ( WARN , msg) 
     deallocate(dims)
     deallocate(count)
     deallocate(offset)
     deallocate(sizes)
     return
  endif


  ! write the data in memory space to file space
  CALL h5dwrite_f(dset_id,FieldType,XField,dimsfi,hdf5err,&
       mem_space_id =dspace_id,file_space_id =fspace_id, &
       xfer_prp = xfer_list)
  if(hdf5err.lt.0) then
     Status =  WRF_HDF5_ERR_DATASET_WRITE
     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
     call wrf_debug ( WARN , msg) 
     deallocate(dims)
     deallocate(count)
     deallocate(offset)
     deallocate(sizes)
     return
  endif

  CALL h5pclose_f(xfer_list,hdf5err)
  if(hdf5err.lt.0) then
     Status =  WRF_HDF5_ERR_PROPERTY_LIST
     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
     call wrf_debug ( WARN , msg) 
     deallocate(dims)
     deallocate(count)
     deallocate(offset)
     deallocate(sizes)
     return
  endif

  if(TimeIndex == 1) then
     do i =1, MaxVars
        if(DH%dsetids(i) == -1) then
           DH%dsetids(i) = dset_id
           DH%VarNames(i) = DataSetName
           exit
        endif
     enddo
     ! Only writing attributes when TimeIndex ==1
     call write_hdf5_attributes(DataHandle,MemoryOrder,WrfDType,DimRank,&
          NDim,dset_id,Status)
  endif

  call h5sclose_f(fspace_id,hdf5err)
  call h5sclose_f(dspace_id,hdf5err)
  if(TimeIndex /= 1) then
     call h5dclose_f(dset_id,hdf5err)  
  endif
  if(hdf5err.lt.0) then
     Status =  WRF_HDF5_ERR_DATASPACE  
     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
     call wrf_debug ( WARN , msg) 
     deallocate(dims)
     deallocate(count)
     deallocate(offset)
     deallocate(sizes)
     return
  endif
  Status = WRF_NO_ERR
  return
end subroutine  HDF5IOWRITE


subroutine ext_phdf5_ioinit(SysDepInfo, Status)

  use wrf_phdf5_data
  use HDF5
  implicit none

  include 'wrf_status_codes.h'
  include 'mpif.h'

  CHARACTER*(*), INTENT(IN) :: SysDepInfo
  integer, intent(out) :: status
  integer              :: hdf5err

  ! set up some variables inside the derived type
  WrfDataHandles(1:WrfDataHandleMax)%Free = .true.
  ! ?
  WrfDataHandles(1:WrfDataHandleMax)%TimesName    = 'Times' 
  WrfDataHandles(1:WrfDataHandleMax)%DimUnlimName = 'Time'  

  ! set up HDF5 global variables
  call h5open_f(hdf5err)
  if(hdf5err .lt.0) then 
     Status =  WRF_HDF5_ERR_CLOSE_GENERAL
     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
     call wrf_debug ( WARN , msg) 
     return
  endif
  return
end subroutine ext_phdf5_ioinit


subroutine ext_phdf5_ioclose( DataHandle, Status)

  use wrf_phdf5_data
  use ext_phdf5_support_routines
  use hdf5
  implicit none
  include 'wrf_status_codes.h'   
  include 'mpif.h'

  integer              ,intent(in)       :: DataHandle
  integer              ,intent(out)      :: Status
  type(wrf_phdf5_data_handle),pointer     :: DH
  integer                                :: stat
  integer                                :: NVar
  integer                                :: hdferr
  integer                                :: table_length
  integer                                :: i
  integer(hid_t)                         :: dtype_id
  integer                                :: obj_count
  integer(hid_t),allocatable,dimension(:) :: obj_ids
  character(len=100)                       :: buf
  integer(size_t)                        :: name_size

  call GetDH(DataHandle,DH,Status)
  if(Status /= WRF_NO_ERR) then
     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', 906
     call wrf_debug ( WARN , msg)
     return
  endif

  ! THE FOLLOWING section writes dimscale information to the data set,may be put into a subroutine

  ! check the file status, should be either open_for_read or opened_and_committed
  if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
     Status = WRF_HDF5_ERR_FILE_OPEN
     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
     call wrf_debug ( WARN , msg)
  elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
     Status = WRF_HDF5_ERR_DRYRUN_CLOSE
     write(msg,*) 'Warning TRY TO CLOSE DRYRUN in ',__FILE__,', line', __LINE__
     call wrf_debug ( WARN , msg)

  elseif(DH%FileStatus == WRF_FILE_OPENED_AND_COMMITTED) then
     ! Handle dim. scale
     ! STORE "Times" as the first element of the dimensional table

     DH%DIMTABLE(1)%dim_name  = 'Time'
     DH%DIMTABLE(1)%Length    = DH%TimeIndex
     DH%DIMTABLE(1)%unlimited = 1

     do i =1,MaxTabDims
        if(DH%DIMTABLE(i)%dim_name== NO_NAME) then
           exit
        endif
     enddo

     table_length = i-1
     call store_table(DataHandle,table_length,Status)
     if(Status.ne.WRF_NO_ERR) then
        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
        call wrf_debug ( WARN , msg) 
        return
     endif
     continue    
  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
     !     call h5dclose_f(DH%TimesID,hdferr)
     !     if(hdferr.lt.0) then 
     !       Status =  WRF_HDF5_ERR_DATASET_CLOSE
     !       write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
     !       call wrf_debug ( WARN , msg) 
     !       return
     !     endif
     continue
  else
     Status = WRF_HDF5_ERR_BAD_FILE_STATUS
     write(msg,*) 'Fatal hdf5err BAD FILE STATUS in ',__FILE__,', line', __LINE__
     call wrf_debug ( FATAL , msg)
     return
  endif

  ! close HDF5 APIs 
  do NVar = 1, MaxVars
     if(DH%DsetIDs(NVar) /= -1) then
        call h5dclose_f(DH%DsetIDs(NVar),hdferr)
        if(hdferr .ne. 0) then
           Status =  WRF_HDF5_ERR_DATASET_CLOSE
           write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
           call wrf_debug ( WARN , msg) 
           return
        endif
     endif
  enddo

  do i = 1, MaxTimes
     if(DH%TgroupIDs(i) /= -1) then
        call h5gclose_f(DH%TgroupIDs(i),hdferr)
        if(hdferr .ne. 0) then
           Status =  WRF_HDF5_ERR_DATASET_CLOSE
           write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
           call wrf_debug ( WARN , msg) 
           return
        endif
     endif
  enddo

  call h5gclose_f(DH%GroupID,hdferr)
  if(hdferr .ne. 0) then
     Status =  WRF_HDF5_ERR_CLOSE_GENERAL
     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
     call wrf_debug ( WARN , msg) 
     return
  endif

  call h5gclose_f(DH%DimGroupID,hdferr)
  if(hdferr .ne. 0) then
     Status =  WRF_HDF5_ERR_CLOSE_GENERAL
     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
     call wrf_debug ( WARN , msg) 
     return
  endif

  if(Status /= WRF_NO_ERR) then
     write(msg,*) 'HDF5 IO CLOSE error in ',__FILE__,', line', __LINE__
     call wrf_debug ( WARN , msg)
     return
  endif

  call h5fclose_f(DH%FileID,hdferr)
  if(hdferr .ne. 0) then
     Status =  WRF_HDF5_ERR_CLOSE_GENERAL
     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
     call wrf_debug ( WARN , msg) 
     return
  endif

  if(Status /= WRF_NO_ERR) then
     write(msg,*) 'HDF5 IO CLOSE error in ',__FILE__,', line', __LINE__
     call wrf_debug ( WARN , msg)
     return
  endif

  call free_memory(DataHandle,Status)
  if(Status /= WRF_NO_ERR) then
     Status = WRF_HDF5_ERR_OTHERS
     write(msg,*) 'Warning Status = ',__FILE__,', line', __LINE__
     call wrf_debug ( WARN , msg)
     return
  endif

  DH%Free=.true.
  return
end subroutine ext_phdf5_ioclose


subroutine ext_phdf5_ioexit(Status)

  use wrf_phdf5_data
  use ext_phdf5_support_routines
  use HDF5
  implicit none
  include 'wrf_status_codes.h'
  include 'mpif.h'

  integer              ,intent(out)      :: Status
  integer                                :: hdf5err
  type(wrf_phdf5_data_handle),pointer     :: DH
  integer                                :: i
  integer                                :: stat


  ! free memories 
  do i=1,WrfDataHandleMax
     if(.not.WrfDataHandles(i)%Free) then
        call free_memory(i,Status)
        exit
     endif
  enddo

  if(Status /= WRF_NO_ERR) then
     write(msg,*) 'free resources error in ',__FILE__,', line', __LINE__
     call wrf_debug ( WARN , msg)
     return
  endif

  CALL h5close_f(hdf5err)

  if(hdf5err.lt.0) then
     Status = WRF_HDF5_ERR_CLOSE_GENERAL
     write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
     call wrf_debug ( FATAL , msg)
     return
  endif

  return
end subroutine ext_phdf5_ioexit



!! This routine will set up everything to read HDF5 files
subroutine ext_phdf5_open_for_read(FileName,Comm,iocomm,SysDepInfo,DataHandle,Status)

  use wrf_phdf5_data
  use ext_phdf5_support_routines
  use HDF5
  implicit none
  include 'mpif.h'
  include 'wrf_status_codes.h'

  character*(*),intent(in)                     :: FileName
  integer      ,intent(in)                     :: Comm
  integer      ,intent(in)                     :: iocomm
  character*(*),intent(in)                     :: SysDepInfo
  integer      ,intent(out)                    :: DataHandle
  type(wrf_phdf5_data_handle),pointer          :: DH
  integer      ,intent(out)                    :: Status

  integer(hid_t)                               :: Fileid
  integer(hid_t)                               :: tgroupid
  integer(hid_t)                               :: dsetid
  integer(hid_t)                               :: dspaceid
  integer(hid_t)                               :: dtypeid
  integer(hid_t)                               :: acc_plist
  integer                                      :: nmembers
  integer                                      :: submembers
  integer                                      :: tmembers
  integer                                      :: ObjType
  character(len= 256)                           :: ObjName
  character(len= 256)                           :: GroupName

  integer                                      :: i,j
  integer(hsize_t), dimension(7)               :: data_dims
  integer(hsize_t), dimension(1)               :: h5dims
  integer(hsize_t), dimension(1)               :: h5maxdims
  integer                                      :: StoredDim
  integer                                      :: NumVars

  integer                                      :: hdf5err
  integer                                      :: info,mpi_size,mpi_rank  
  character(Len = MaxTimeSLen)                 :: tname
  character(Len = 512)                         :: tgroupname


  ! Allocating the data handle
  call allocHandle(DataHandle,DH,Comm,Status)
  if(Status /= WRF_NO_ERR) then
     return
  endif

  call h5pcreate_f(H5P_FILE_ACCESS_F,acc_plist,hdf5err)
  if(hdf5err.lt.0) then
     Status =  WRF_HDF5_ERR_PROPERTY_LIST
     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
     call wrf_debug ( WARN , msg) 
     return
  endif

  info = MPI_INFO_NULL
  CALL h5pset_fapl_mpio_f(acc_plist, comm, info, hdf5err) 
  !   call h5pset_fapl_mpiposix_f(acc_plist,comm,.false.,hdf5err)
  if(hdf5err .lt. 0) then
     Status = WRF_HDF5_ERR_PROPERTY_LIST
     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
     call wrf_debug ( WARN , msg) 
     return
  endif
  !close every objects when closing HDF5 file.
  call h5pset_fclose_degree_f(acc_plist,H5F_CLOSE_STRONG_F,hdf5err)
  if(hdf5err .lt. 0) then
     Status = WRF_HDF5_ERR_PROPERTY_LIST
     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
     call wrf_debug ( WARN , msg) 
     return
  endif


  ! Open the file
  call h5fopen_f(FileName,H5F_ACC_RDWR_F,Fileid,hdf5err &
       ,acc_plist)
  if(hdf5err.lt.0) then
     Status =  WRF_HDF5_ERR_FILE_OPEN
     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
     call wrf_debug ( WARN , msg) 
     return
  endif
  call h5pclose_f(acc_plist,hdf5err)
  if(hdf5err .lt. 0) then
     Status = WRF_HDF5_ERR_PROPERTY_LIST
     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
     call wrf_debug ( WARN , msg) 
     return
  endif


  ! Obtain the number of group
  DH%FileID = Fileid
  call h5gn_members_f(Fileid,"/",nmembers,hdf5err)
  if(hdf5err.lt.0) then
     Status = WRF_HDF5_ERR_GROUP
     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
     call wrf_debug ( WARN , msg) 
     return
  endif

  ! Retrieve group id and dimensional group id, the index must be from 0
  do i = 0, nmembers - 1
     call h5gget_obj_info_idx_f(Fileid,"/",i,ObjName,ObjType,&
          hdf5err)
     if(hdf5err.lt.0) then
        Status = WRF_HDF5_ERR_GROUP
        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
        call wrf_debug ( WARN , msg) 
        return
     endif

     if(ObjName=='DIM_GROUP') then

        call h5gopen_f(Fileid,"/DIM_GROUP",DH%DimGroupID,hdf5err)
        if(hdf5err.lt.0) then
           Status = WRF_HDF5_ERR_GROUP
           write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
           call wrf_debug ( WARN , msg) 
           return
        endif

        ! For WRF model, the first seven character must be DATASET
     else if(ObjName(1:7)=='DATASET')then

        GroupName="/"//ObjName
        call h5gopen_f(Fileid,GroupName,DH%GroupID,hdf5err)
        if(hdf5err.lt.0) then
           Status = WRF_HDF5_ERR_GROUP
           write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
           call wrf_debug ( WARN , msg) 
           return
        endif

        call h5gn_members_f(FileID,GroupName,submembers,Status)
        if(hdf5err.lt.0) then
           Status = WRF_HDF5_ERR_GROUP
           write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
           call wrf_debug ( WARN , msg) 
           return
        endif

        do j = 0, submembers -1
           call h5gget_obj_info_idx_f(Fileid,GroupName,j,ObjName,ObjType,hdf5err)
           if(hdf5err.lt.0) then
              Status = WRF_HDF5_ERR_GROUP
              write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
              call wrf_debug ( WARN , msg) 
              return
           endif
           call numtochar(j+1,tname)
           tgroupname = 'TIME_STAMP_'//tname

           if(ObjName(1:17)==tgroupname) then
              call h5gopen_f(DH%GroupID,tgroupname,tgroupid,hdf5err)
              if(hdf5err.lt.0) then
                 Status = WRF_HDF5_ERR_GROUP
                 write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
                 call wrf_debug ( WARN , msg) 
                 return
              endif
              call h5gn_members_f(DH%GroupID,tgroupname,tmembers,hdf5err)
              if(hdf5err.lt.0) then
                 Status = WRF_HDF5_ERR_GROUP
                 write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
                 call wrf_debug ( WARN , msg) 
                 return
              endif
              call h5dopen_f(tgroupid,"Times",dsetid,hdf5err)
              if(hdf5err.lt.0) then
                 Status = WRF_HDF5_ERR_DATASET_OPEN
                 write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
                 call wrf_debug ( WARN , msg) 
                 return
              endif
              call h5dget_space_f(dsetid,dspaceid,hdf5err)
              if(hdf5err.lt.0) then
                 Status = WRF_HDF5_ERR_DATASPACE
                 write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
                 call wrf_debug ( WARN , msg) 
                 return
              endif
              call h5sget_simple_extent_ndims_f(dspaceid,StoredDim,hdf5err)
              if(hdf5err.lt.0) then
                 Status = WRF_HDF5_ERR_DATASPACE
                 write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
                 call wrf_debug ( WARN , msg) 
                 return
              endif
              call h5sget_simple_extent_dims_f(dspaceid,h5dims,h5maxdims,hdf5err)  
              if(hdf5err.lt.0) then
                 Status = WRF_HDF5_ERR_DATASPACE
                 write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
                 call wrf_debug ( WARN , msg) 
                 return
              endif
	      data_dims(1) = h5dims(1)
              call h5dget_type_f(dsetid,dtypeid,hdf5err)
              if(hdf5err.lt.0) then
                 Status = WRF_HDF5_ERR_DATATYPE
                 write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
                 call wrf_debug ( WARN , msg) 
                 return
              endif
              call h5dread_f(dsetid,dtypeid,DH%Times(j+1),data_dims,hdf5err)
              if(hdf5err.lt.0) then
                 Status = WRF_HDF5_ERR_DATASET_READ
                 write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
                 call wrf_debug ( WARN , msg) 
                 return
              endif
              DH%CurrentVariable = 0
              DH%CurrentTime     = 0
              DH%TimeIndex       = 0 
              call h5tclose_f(dtypeid,hdf5err)
              call h5sclose_f(dspaceid,hdf5err)
           endif
        enddo
        DH%NumberTimes = submembers

        !       the total member of HDF5 dataset. 
        DH%NumVars = tmembers*submembers
     else
        Status = WRF_HDF5_ERR_OTHERS
     endif
  enddo

  DH%FileStatus      = WRF_FILE_OPENED_FOR_READ
  DH%FileName        = FileName

  ! obtain dimensional scale table
  call retrieve_table(DataHandle,Status)
  if(Status /= WRF_NO_ERR) then
     return
  endif
  return

end subroutine ext_phdf5_open_for_read


subroutine ext_phdf5_inquire_opened(DataHandle,FileName,FileStatus,Status)

  use wrf_phdf5_data
  use ext_phdf5_support_routines
  use HDF5
  implicit none
  include 'wrf_status_codes.h'
  integer                    ,intent(in)     :: DataHandle
  character*(*)              ,intent(in)     :: FileName
  integer                    ,intent(out)    :: FileStatus
  integer                    ,intent(out)    :: Status
  type(wrf_phdf5_data_handle) ,pointer       :: DH


  call GetDH(DataHandle,DH,Status)
  if(Status /= WRF_NO_ERR) then
     FileStatus = WRF_FILE_NOT_OPENED
     return
  endif
  if(FileName /= DH%FileName) then
     FileStatus = WRF_FILE_NOT_OPENED
  else
     FileStatus = DH%FileStatus
  endif
  Status = WRF_NO_ERR
  return
end subroutine ext_phdf5_inquire_opened


subroutine ext_phdf5_inquire_filename(DataHandle,FileName,FileStatus,Status)

  use wrf_phdf5_data
  use ext_phdf5_support_routines
  use HDF5
  implicit none
  include 'wrf_status_codes.h'

  integer               ,intent(in)     :: DataHandle
  character*(*)         ,intent(out)     :: FileName
  integer               ,intent(out)    :: FileStatus
  integer               ,intent(out)    :: Status
  type(wrf_phdf5_data_handle) ,pointer        :: DH

  ! This line is added to make sure the wrong file will not be opened 
  FileStatus = WRF_FILE_NOT_OPENED

  call GetDH(DataHandle,DH,Status)
  if(Status /= WRF_NO_ERR) then
     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,',line',__LINE__
     call wrf_debug (WARN, msg)
     return
  endif

  FileName = DH%FileName
  FileStatus = DH%FileStatus
  Status = WRF_NO_ERR

  return 
end subroutine ext_phdf5_inquire_filename


! The real routine to read HDF5 files
subroutine ext_phdf5_read_field(DataHandle,DateStr,Var,Field,FieldType,Comm,  &
     IOComm, DomainDesc, MemoryOrder, Stagger, DimNames, &
     DomainStart,DomainEnd,MemoryStart,MemoryEnd, &
     PatchStart,PatchEnd,Status)

  use wrf_phdf5_data
  use ext_phdf5_support_routines
  use HDF5

  implicit none
  include 'wrf_status_codes.h'
  integer                       ,intent(in)    :: DataHandle
  character*(*)                 ,intent(in)    :: DateStr
  character*(*)                 ,intent(in)    :: Var
  integer                       ,intent(out)   :: Field(*)
  integer                       ,intent(in)    :: FieldType
  integer                       ,intent(inout) :: Comm
  integer                       ,intent(inout) :: IOComm
  integer                       ,intent(in)    :: DomainDesc
  character*(*)                 ,intent(in)    :: MemoryOrder
  character*(*)                 ,intent(in)    :: Stagger ! Dummy for now
  character*(*) , dimension (*) ,intent(in)    :: DimNames
  integer ,dimension(*)         ,intent(in)    :: DomainStart, DomainEnd
  integer ,dimension(*)         ,intent(in)    :: MemoryStart, MemoryEnd
  integer ,dimension(*)         ,intent(in)    :: PatchStart,  PatchEnd
  integer                       ,intent(out)   :: Status

  type(wrf_phdf5_data_handle)    ,pointer       :: DH
  integer                                      :: NDim
  integer(hid_t)                               :: GroupID
  character (VarNameLen)                       :: VarName
  integer ,dimension(NVarDims)                 :: Length
  integer ,dimension(NVarDims)                 :: StoredStart
  integer ,dimension(NVarDims)                 :: StoredLen
  integer, dimension(NVarDims)                 :: TemDataStart
  integer ,dimension(:,:,:,:)  ,allocatable    :: XField
  integer                                      :: NVar
  integer                                      :: j
  integer                                      :: i1,i2,j1,j2,k1,k2
  integer                                      :: x1,x2,y1,y2,z1,z2
  integer                                      :: l1,l2,m1,m2,n1,n2
  character (VarNameLen)                       :: Name
  integer                                      :: XType
  integer                                      :: StoredDim
  integer                                      :: NAtts
  integer                                      :: Len
  integer                                      :: stat
  integer                                      :: di
  integer                                      :: FType
  integer(hsize_t),dimension(7)                :: data_dims
  integer(hsize_t),dimension(:) ,allocatable   :: h5_dims
  integer(hsize_t),dimension(:) ,allocatable   :: h5_maxdims
  integer(hsize_t),dimension(:) ,allocatable   :: DataStart
  integer(hsize_t),dimension(:) ,allocatable   :: Datacount
  integer(hid_t)                               :: tgroupid
  integer(hid_t)                               :: dsetid
  integer(hid_t)                               :: dtype_id
  integer(hid_t)                               :: dmemtype_id
  integer(hid_t)                               :: dspace_id
  integer(hid_t)                               :: memspace_id
  integer                                      :: class_type
  integer                                      :: TimeIndex
  logical                                      :: flag
  integer                                      :: hdf5err

  character(Len = MaxTimeSLen)                 :: tname
  character(Len = 512)                         :: tgroupname


  ! FOR PARALLEL IO
  integer                                      :: mpi_rank
  integer(hid_t)                               :: xfer_list


  call GetDH(DataHandle,DH,Status)
  if(Status /= WRF_NO_ERR) then
     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
     call wrf_debug ( WARN , msg)
     return
  endif

  if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
     Status = WRF_HDF5_ERR_FILE_NOT_OPENED
     write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__ 
     call wrf_debug ( WARN , msg)
  elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
     Status = WRF_HDF5_ERR_DRYRUN_READ
     write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__ 
     call wrf_debug ( WARN , msg)
  elseif(DH%FileStatus == WRF_FILE_OPENED_AND_COMMITTED) then
     Status = WRF_HDF5_ERR_READ_WONLY_FILE
     write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__ 
     call wrf_debug ( WARN , msg)
  elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then

     ! obtain TimeIndex
     call GetDataTimeIndex('read',DataHandle,DateStr,TimeIndex,Status)

     ! obtain the absolute name of the group where the dataset is located
     call numtochar(TimeIndex,tname)
     tgroupname = 'TIME_STAMP_'//tname

     call h5gopen_f(DH%GroupID,tgroupname,tgroupid,hdf5err)
     if(hdf5err.lt.0) then
        Status = WRF_HDF5_ERR_GROUP
        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
        call wrf_debug ( WARN , msg) 
        return
     endif

     call h5dopen_f(tgroupid,Var,dsetid,hdf5err)
     if(hdf5err.lt.0) then
        Status = WRF_HDF5_ERR_DATASET_OPEN
        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
        call wrf_debug ( WARN , msg) 
        return
     endif

     ! Obtain the memory datatype
     select case(FieldType)
     case (WRF_REAL)
        dmemtype_id = H5T_NATIVE_REAL
     case (WRF_DOUBLE)
        dmemtype_id = H5T_NATIVE_DOUBLE
     case (WRF_INTEGER)
        dmemtype_id = H5T_NATIVE_INTEGER
     case (WRF_LOGICAL)
        dmemtype_id = DH%EnumID
     case default
        Status = WRF_HDF5_ERR_DATA_TYPE_NOTFOUND
        write(msg,*) 'Warning BAD Memory Data type in ',__FILE__,',line',__LINE__
        call wrf_debug(WARN,msg)
        return
     end select

     ! Obtain the datatype
     call h5dget_type_f(dsetid,dtype_id,hdf5err)
     if(hdf5err.lt.0) then
        Status = WRF_HDF5_ERR_DATATYPE
        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
        call wrf_debug ( WARN , msg) 
        return
     endif

     ! double check whether the Fieldtype is the type of the dataset
     ! we may do the force coercion between real and double
     call h5tget_class_f(dtype_id,class_type,hdf5err)
     if(hdf5err.lt.0) then
        Status = WRF_HDF5_ERR_DATATYPE
        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
        call wrf_debug ( WARN , msg) 
        return
     endif

     if( (FieldType == WRF_REAL .OR. FieldType == WRF_DOUBLE) ) then
        if ( class_type /= H5T_FLOAT_F)  then
           Status = WRF_HDF5_ERR_TYPE_MISMATCH
           write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
           call wrf_debug ( WARN , msg)
           return
        endif
     else if(FieldType == WRF_CHARACTER) then
        if(class_type /= H5T_STRING_F) then
           Status = WRF_HDF5_ERR_TYPE_MISMATCH
           write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
           call wrf_debug ( WARN , msg)
           return
        endif
     else if(FieldType == WRF_INTEGER) then 
        if(class_type /= H5T_INTEGER_F) then
           Status = WRF_HDF5_ERR_TYPE_MISMATCH
           write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
           call wrf_debug ( WARN , msg)
           return
        endif
     else if(FieldType == WRF_LOGICAL) then
        if(class_type /= H5T_ENUM_F) then
           Status = WRF_HDF5_ERR_TYPE_MISMATCH
           write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
           call wrf_debug ( WARN , msg)
           return
        endif
        call h5tequal_f(dtype_id,DH%EnumID,flag,hdf5err)
        if(hdf5err.lt.0) then
           Status = WRF_HDF5_ERR_DATASET_OPEN
           write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
           call wrf_debug ( WARN , msg) 
           return
        endif
        if(flag .EQV. .FALSE.) then
           Status = WRF_HDF5_ERR_TYPE_MISMATCH
           write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
           call wrf_debug ( WARN , msg)
           return
        endif
     else 
        Status = WRF_HDF5_ERR_BAD_DATA_TYPE
        write(msg,*)'Fatal Non-WRF supported TYPE in ',__FILE__,', line',__LINE__
        call wrf_debug(FATAL, msg)
        return
     endif

     ! Obtain the dataspace, check whether the dataspace is within the range
     ! transpose the memory order to the disk order
     call h5dget_space_f(dsetid,dspace_id,hdf5err)
     if(hdf5err.lt.0) then
        Status = WRF_HDF5_ERR_DATASPACE
        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
        call wrf_debug ( WARN , msg) 
        return
     endif

     call GetDim(MemoryOrder,NDim,Status)

     Length(1:NDim) = PatchEnd(1:NDim)-PatchStart(1:NDim)+1
     call ExtOrder(MemoryOrder,Length,Status)

     ! Obtain the rank of the dimension
     call h5sget_simple_extent_ndims_f(dspace_id,StoredDim,hdf5err)
     if(hdf5err.lt.0) then
        Status = WRF_HDF5_ERR_DATASPACE
        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
        call wrf_debug ( WARN , msg) 
        return
     endif

     ! From NetCDF implementation, only do error handling
     if((NDim+1) /= StoredDim) then
        Status = WRF_HDF5_ERR_BAD_VARIABLE_DIM
        write(msg,*) 'Fatal error BAD VARIABLE DIMENSION in ',__FILE__,', line', __LINE__
        call wrf_debug ( FATAL , msg)
        return
     endif
     allocate(h5_dims(StoredDim))
     allocate(h5_maxdims(StoredDim))
     allocate(DataStart(StoredDim))
     allocate(DataCount(StoredDim))

     call h5sget_simple_extent_dims_f(dspace_id,h5_dims,h5_maxdims,hdf5err)
     if(hdf5err.lt.0) then
        Status = WRF_HDF5_ERR_DATASPACE
        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
        call wrf_debug ( WARN , msg) 
        return
     endif

     ! This part of code needs to be adjusted, currently use NetCDF convention  
     do j = 1, NDim
        if(Length(j) > h5_dims(j)) then
           Status = WRF_HDF5_ERR_READ_PAST_EOF
           write(msg,*) 'Warning READ PAST EOF in ',__FILE__,', line', __LINE__
           call wrf_debug ( WARN , msg)
           return
        elseif(Length(j) <= 0) then
           Status = WRF_HDF5_ERR_ZERO_LENGTH_READ
           write(msg,*) 'Warning ZERO LENGTH READ in ',__FILE__,', line', __LINE__
           call wrf_debug ( WARN , msg)
           return
        endif
     enddo

     ! create memspace_id 
     data_dims(1:NDim) = Length(1:NDim)
     data_dims(NDim+1) = 1

     call h5screate_simple_f(NDim+1,data_dims,memspace_id,hdf5err)
     if(hdf5err.lt.0) then
        Status = WRF_HDF5_ERR_DATASPACE
        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
        call wrf_debug ( WARN , msg) 
        return
     endif

     ! DataStart can start from PatchStart.
     TEMDataStart(1:NDim) = PatchStart(1:NDim)-1

     if(MemoryOrder.NE.'0') then
        call ExtOrder(MemoryOrder,TEMDataStart,Status)
     endif

     DataStart(1:NDim) = TEMDataStart(1:NDim)
     DataStart(NDim+1) = 0
     DataCount(1:NDim) = Length(1:NDim)
     DataCount(NDim+1) = 1

     ! transpose the data XField to Field
     call GetIndices(NDim,MemoryStart,MemoryEnd,l1,l2,m1,m2,n1,n2)
     StoredStart = 1
     StoredLen(1:NDim) = Length(1:NDim)

     ! the dimensional information inside the disk may be greater than
     ! the dimension(PatchEnd-PatchStart); here we can speed up
     ! the performance by using hyperslab selection
     call GetIndices(NDim,StoredStart,StoredLen,x1,x2,y1,y2,z1,z2)
     call GetIndices(NDim,PatchStart,PatchEnd,i1,i2,j1,j2,k1,k2)

     ! di is for double type data
     di = 1 
     if(FieldType == WRF_DOUBLE) di = 2
     allocate(XField(di,x1:x2,y1:y2,z1:z2), STAT=stat)

     ! use hyperslab to only read this current timestamp
     call h5sselect_hyperslab_f(dspace_id,H5S_SELECT_SET_F, &
          DataStart,DataCount,hdf5err)
     if(hdf5err.lt.0) then
        Status = WRF_HDF5_ERR_DATASET_GENERAL
        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
        call wrf_debug ( WARN , msg) 
        return
     endif

     ! read the data in this time stamp
     call h5dread_f(dsetid,dmemtype_id,XField,data_dims,hdf5err, &
          memspace_id,dspace_id,H5P_DEFAULT_F)
     if(hdf5err.lt.0) then
        Status = WRF_HDF5_ERR_DATASET_READ
        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
        call wrf_debug ( WARN , msg) 
        return
     endif

     call transpose_hdf5('read',MemoryOrder,di, Field,l1,l2,m1,m2,n1,n2 &
          ,XField,x1,x2,y1,y2,z1,z2 &
          ,i1,i2,j1,j2,k1,k2 )

     deallocate(XField, STAT=stat)
     if(stat/= 0) then
        Status = WRF_HDF5_ERR_DEALLOCATION
        write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
        call wrf_debug ( FATAL , msg)
        return
     endif

     call h5dclose_f(dsetid,hdf5err)
     if(hdf5err.lt.0) then
        Status = WRF_HDF5_ERR_DATASET_CLOSE
        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
        call wrf_debug ( WARN , msg) 
        return
     endif
     deallocate(h5_dims)
     deallocate(h5_maxdims)
     deallocate(DataStart)
     deallocate(DataCount)
  else 
     Status = WRF_HDF5_ERR_BAD_FILE_STATUS
     write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__ 
     call wrf_debug ( FATAL , msg)
  endif

  DH%first_operation  = .FALSE.

  return
end subroutine ext_phdf5_read_field

!! This routine essentially sets up everything to write HDF5 files
SUBROUTINE ext_phdf5_open_for_write_begin(FileName,Comm,IOComm,SysDepInfo,DataHandle,Status)

  use wrf_phdf5_data
  use HDF5
  use ext_phdf5_support_routines
  implicit none
  include 'mpif.h'
  include 'wrf_status_codes.h'

  character*(*)        ,intent(in)            :: FileName
  integer              ,intent(in)            :: Comm
  integer              ,intent(in)            :: IOComm
  character*(*)        ,intent(in)            :: SysDepInfo
  integer              ,intent(out)           :: DataHandle
  integer              ,intent(out)           :: Status
  type(wrf_phdf5_data_handle),pointer          :: DH
  integer(hid_t)                              :: file5_id
  integer(hid_t)                              :: g_id
  integer(hid_t)                              :: gdim_id
  integer                                     :: hdferr
  integer                                     :: i
  integer                                     :: stat
  character (7)                               :: Buffer
  integer                                     :: VDimIDs(2)
  character(Len = 512)                        :: groupname

  ! For parallel IO
  integer(hid_t)                              :: plist_id
  integer                                     :: hdf5_comm,info,mpi_size,mpi_rank  


  call allocHandle(DataHandle,DH,Comm,Status)
  if(Status /= WRF_NO_ERR) then
     write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
     call wrf_debug ( FATAL , msg)
     return
  endif
  DH%TimeIndex = 0
  DH%Times     = ZeroDate

  CALL h5pcreate_f(H5P_FILE_ACCESS_F, plist_id, hdferr)
  if(hdferr .lt. 0) then
     Status = WRF_HDF5_ERR_PROPERTY_LIST
     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
     call wrf_debug ( WARN , msg) 
     return
  endif

  info      = MPI_INFO_NULL

  CALL h5pset_fapl_mpio_f(plist_id, comm, info, hdferr)

  if(hdferr .lt. 0) then
     Status = WRF_HDF5_ERR_PROPERTY_LIST
     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
     call wrf_debug ( WARN , msg) 
     return
  endif

  call h5fcreate_f(FileName,H5F_ACC_TRUNC_F,file5_id,hdferr &
       ,access_prp = plist_id)
  if(hdferr .lt. 0) then
     Status = WRF_HDF5_ERR_FILE_CREATE
     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
     call wrf_debug ( WARN , msg) 
     return
  endif

  call h5pclose_f(plist_id,hdferr)
  if(hdferr .lt. 0) then
     Status = WRF_HDF5_ERR_PROPERTY_LIST
     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
     call wrf_debug ( WARN , msg) 
     return
  endif

  DH%FileStatus            = WRF_FILE_OPENED_NOT_COMMITTED
  DH%FileName              = FileName
  ! should add a check to see whether the file opened has been used by previous handles
  DH%VarNames  (1:MaxVars) = NO_NAME
  DH%MDVarNames(1:MaxVars) = NO_NAME

  ! group name information is stored at SysDepInfo 
  groupname = "/"//SysDepInfo
!  write(*,*) "groupname ",groupname
  call h5gcreate_f(file5_id,groupname,g_id,hdferr)
  if(hdferr .lt. 0) then
     Status = WRF_HDF5_ERR_GROUP
     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
     call wrf_debug ( WARN , msg) 
     return
  endif

  ! create dimensional group id
  call h5gcreate_f(file5_id,"/DIM_GROUP",gdim_id,hdferr)
  if(hdferr .lt. 0) then
     Status = WRF_HDF5_ERR_GROUP
     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
     call wrf_debug ( WARN , msg) 
     return
  endif

  DH%FileID     = file5_id
  DH%GroupID    = g_id
  DH%DIMGroupID = gdim_id

  return

end subroutine ext_phdf5_open_for_write_begin

! HDF5 doesnot need this stage, basically this routine
! just updates the File status.
SUBROUTINE ext_phdf5_open_for_write_commit(DataHandle, Status)

  use wrf_phdf5_data
  use ext_phdf5_support_routines
  use HDF5
  implicit none
  include 'wrf_status_codes.h'

  integer              ,intent(in)       :: DataHandle
  integer              ,intent(out)      :: Status
  type(wrf_phdf5_data_handle),pointer     :: DH
  integer(hid_t)                         :: enum_type
  integer                                :: i
  integer                                :: stat


  call GetDH(DataHandle,DH,Status)
  if(Status /= WRF_NO_ERR) then
     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
     call wrf_debug ( WARN , msg) 
     return
  endif

  DH%FileStatus  = WRF_FILE_OPENED_AND_COMMITTED
  DH%first_operation  = .TRUE.
  return
end subroutine ext_phdf5_open_for_write_commit

! The real routine to write HDF5 file
subroutine ext_phdf5_write_field(DataHandle,DateStr,Var,Field,FieldType,&
     Comm,IOComm,DomainDesc,MemoryOrder,  &
     Stagger,DimNames,DomainStart,DomainEnd,&
     MemoryStart,MemoryEnd,PatchStart,PatchEnd,&
     Status)

  use wrf_phdf5_data
  use ext_phdf5_support_routines
  USE HDF5 ! This module contains all necessary modules 
  implicit none
  include 'wrf_status_codes.h'

  integer                       ,intent(in)      :: DataHandle
  character*(*)                 ,intent(in)      :: DateStr
  character*(*)                 ,intent(in)      :: Var
  integer                       ,intent(inout)   :: Field(*)
  integer                       ,intent(in)      :: FieldType
  integer                       ,intent(inout)   :: Comm
  integer                       ,intent(inout)   :: IOComm
  integer                       ,intent(in)      :: DomainDesc
  character*(*)                 ,intent(in)      :: MemoryOrder
  character*(*)                 ,intent(in)      :: Stagger ! Dummy for now
  character*(*) , dimension (*) ,intent(in)      :: DimNames
  integer ,dimension(*)         ,intent(in)      :: DomainStart, DomainEnd
  integer ,dimension(*)         ,intent(in)      :: MemoryStart, MemoryEnd
  integer ,dimension(*)         …