external/io_phdf5/wrf-phdf5.F90

   1 !/***************************************************************************
   2 !* The HDF5 WRF IO module was written by the the HDF Group at NCSA, the     *
   3 !* National Center for Supercomputing Applications.                         *
   4 !*     HDF Group                                                            *
   5 !*     National Center for Supercomputing Applications                      *
   6 !*     University of Illinois at Urbana-Champaign                           *
   7 !*     605 E. Springfield, Champaign IL 61820                               *
   8 !*     http://hdf.ncsa.uiuc.edu/                                            *
   9 !*                                                                          *
  10 !* Copyright 2004 by the Board of Trustees, University of Illinois,         *
  11 !*                                                                          *
  12 !* Redistribution or use of this IO module, with or without modification,   *
  13 !* is permitted for any purpose, including commercial  purposes.            *
  14 !*                                                                          *
  15 !* This software is an unsupported prototype.  Use at your own risk.        *
  16 !*     http://hdf.ncsa.uiuc.edu/apps/WRF-ROMS                               *
  17 !*                                                                          *
  18 !* This work was funded by the MEAD expedition at the National Center       *
  19 !* for Supercomputing Applications, NCSA.  For more information see:        *
  20 !*     http://www.ncsa.uiuc.edu/expeditions/MEAD                            *
  21 !*                                                                          *
  22 !*                                                                          *
  23 !****************************************************************************/
  24
  25
  26 subroutine HDF5IOWRITE(DataHandle,Comm,DateStr,Length,DomainStart,DomainEnd &
  27      ,PatchStart,PatchEnd,MemoryOrder &
  28      ,WrfDType,FieldType,groupID,TimeIndex &
  29      ,DimRank ,DatasetName,XField,Status)
  30
  31   use wrf_phdf5_data
  32   use ext_phdf5_support_routines
  33   use HDF5
  34   implicit none
  35   include 'mpif.h'
  36   include 'wrf_status_codes.h'
  37
  38   integer                     ,intent(in)     :: DataHandle
  39   integer                     ,intent(inout)  :: Comm
  40   character*(*)               ,intent(in)     :: DateStr
  41   integer,dimension(NVarDims) ,intent(in)     :: Length
  42
  43   integer,dimension(NVarDims) ,intent(in)     :: DomainStart
  44   integer,dimension(NVarDims) ,intent(in)     :: DomainEnd
  45   integer,dimension(NVarDims) ,intent(in)     :: PatchStart
  46   integer,dimension(NVarDims) ,intent(in)     :: PatchEnd
  47
  48   character*(*)               ,intent(in)     :: MemoryOrder
  49
  50   integer                     ,intent(in)     :: WrfDType
  51   integer(hid_t)              ,intent(in)     :: FieldType
  52   integer(hid_t)              ,intent(in)     :: groupID
  53   integer                     ,intent(in)     :: TimeIndex
  54
  55   integer,dimension(*)        ,intent(in)     :: DimRank
  56   character (*)               ,intent(in)     :: DatasetName
  57   integer,dimension(*)        ,intent(inout)  :: XField
  58   integer                     ,intent(out)    :: Status
  59
  60   integer(hid_t)                              :: dset_id
  61   integer                                     :: NDim
  62   integer,dimension(NVarDims)                 :: VStart
  63   integer,dimension(NVarDims)                 :: VCount
  64   character (3)                               :: Mem0
  65   character (3)                               :: UCMem0
  66   type(wrf_phdf5_data_handle) ,pointer         :: DH
  67
  68   ! attribute defination
  69   integer(hid_t)                              :: dimaspace_id  ! DimRank dataspace id
  70   integer(hid_t)                              :: dimattr_id    ! DimRank attribute id
  71   integer(hsize_t) ,dimension(1)              :: dim_space
  72   INTEGER(HID_T)                              :: dspace_id     ! Raw Data memory Dataspace id
  73   INTEGER(HID_T)                              :: fspace_id     ! Raw Data file Dataspace id
  74   INTEGER(HID_T)                              :: crp_list      ! chunk  identifier
  75   integer(hid_t)                              :: h5_atypeid    ! for fieldtype,memorder attribute
  76   integer(hid_t)                              :: h5_aspaceid   ! for fieldtype,memorder
  77   integer(hid_t)                              :: h5_attrid     ! for fieldtype,memorder
  78   integer(hsize_t), dimension(7)              :: adata_dims
  79   integer                                     :: routine_atype
  80
  81
  82   integer,          dimension(:),allocatable  :: dimrank_data
  83
  84   INTEGER(HSIZE_T), dimension(:),allocatable  :: dims  ! Dataset dimensions
  85   INTEGER(HSIZE_T), dimension(:),allocatable  :: sizes ! Dataset dimensions
  86   INTEGER(HSIZE_T), dimension(:),allocatable  :: chunk_dims
  87   INTEGER(HSIZE_T), dimension(:),allocatable  :: hdf5_maxdims
  88   INTEGER(HSIZE_T), dimension(:),allocatable  :: offset
  89   INTEGER(HSIZE_T), dimension(:),allocatable  :: count
  90   INTEGER(HSIZE_T), DIMENSION(7)              :: dimsfi
  91   integer                                     :: hdf5err
  92   integer                                     :: i,j
  93   integer(size_t)                             :: dsetsize
  94
  95   ! FOR PARALLEL IO
  96   integer(hid_t)                              :: xfer_list
  97   logical                                     :: no_par
  98
  99
 100   ! get the handle
 101   call GetDH(DataHandle,DH,Status)
 102   if(Status /= WRF_NO_ERR) then
 103      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 104      call wrf_debug ( WARN , msg)
 105      return
 106   endif
 107
 108   ! get the rank of the dimension
 109   call GetDim(MemoryOrder,NDim,Status)
 110   if(Status /= WRF_NO_ERR) then
 111      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 112      call wrf_debug ( WARN , msg)
 113      return
 114   endif
 115
 116   ! If patch is equal to domain, the parallel is not necessary, sequential is used.
 117   ! In this version, we haven't implemented this yet.
 118   ! We use no_par to check whether we can use compact data storage.
 119   no_par = .TRUE.
 120   do i = 1,NDim
 121      if((PatchStart(i)/=DomainStart(i)).or.(PatchEnd(i)/=DomainEnd(i))) then
 122         no_par = .FALSE.
 123         exit
 124      endif
 125   enddo
 126
 127   ! change the different Memory Order to XYZ for patch and domain
 128   if(MemoryOrder.NE.'0') then
 129      call ExtOrder(MemoryOrder,PatchStart,Status)
 130      call ExtOrder(MemoryOrder,PatchEnd,Status)
 131      call ExtOrder(MemoryOrder,DomainStart,Status)
 132      call ExtOrder(MemoryOrder,DomainEnd,Status)
 133   endif
 134
 135   ! allocating memory for dynamic arrays;
 136   ! since the time step is always 1, we may ignore the fourth
 137   ! dimension time; now keep it to make it consistent with sequential version
 138   allocate(dims(NDim+1))
 139   allocate(count(NDim+1))
 140   allocate(offset(NDim+1))
 141   allocate(sizes(NDim+1))
 142
 143
 144   ! arrange offset, count for each hyperslab
 145   dims(1:NDim)   = DomainEnd(1:NDim) - DomainStart(1:NDim) + 1
 146   dims(NDim+1)   = 1
 147
 148   count(NDim+1)  = 1
 149   count(1:NDim)  = Length(1:NDim)
 150
 151   offset(NDim+1) = 0
 152   offset(1:NDim) = PatchStart(1:NDim) - 1
 153
 154
 155   ! allocate the dataspace to write hyperslab data
 156
 157   dimsfi = 0
 158   do i = 1, NDim + 1
 159      dimsfi(i) = count(i)
 160   enddo
 161
 162   ! create the memory space id
 163   call h5screate_simple_f(NDim+1,count,dspace_id,hdf5err,count)
 164   if(hdf5err.lt.0) then
 165      Status =  WRF_HDF5_ERR_DATASPACE
 166      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 167      call wrf_debug ( WARN , msg)
 168      deallocate(dims)
 169      deallocate(count)
 170      deallocate(offset)
 171      deallocate(sizes)
 172      return
 173   endif
 174
 175
 176   ! create file space
 177   call h5screate_simple_f(NDim+1,dims,fspace_id,hdf5err,dims)
 178   if(hdf5err.lt.0) then
 179      Status =  WRF_HDF5_ERR_DATASPACE
 180      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 181      call wrf_debug ( WARN , msg)
 182      deallocate(dims)
 183      deallocate(count)
 184      deallocate(offset)
 185      deallocate(sizes)
 186      return
 187   endif
 188
 189   ! compact storage when the patch is equal to the whole domain
 190   ! calculate the non-decomposed dataset size
 191
 192   call h5tget_size_f(FieldType,dsetsize,hdf5err)
 193   if(hdf5err.lt.0) then
 194      Status = WRF_HDF5_ERR_DATATYPE
 195      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 196      call wrf_debug ( WARN , msg)
 197      deallocate(dims)
 198      deallocate(count)
 199      deallocate(offset)
 200      deallocate(sizes)
 201      return
 202   endif
 203
 204   do i =1,NDim
 205      dsetsize = dsetsize*dims(i)
 206   enddo
 207   if(no_par.and.(dsetsize.le.CompDsetSize)) then
 208      call h5pcreate_f(H5P_DATASET_CREATE_F,crp_list,hdf5err)
 209      if(hdf5err.lt.0) then
 210         Status =  WRF_HDF5_ERR_PROPERTY_LIST
 211         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 212         call wrf_debug ( WARN , msg)
 213         deallocate(dims)
 214         deallocate(count)
 215         deallocate(offset)
 216         deallocate(sizes)
 217         return
 218      endif
 219      call h5pset_layout_f(crp_list,0,hdf5err)
 220      if(hdf5err.lt.0) then
 221         Status =  WRF_HDF5_ERR_PROPERTY_LIST
 222         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 223         call wrf_debug ( WARN , msg)
 224         deallocate(dims)
 225         deallocate(count)
 226         deallocate(offset)
 227         deallocate(sizes)
 228         return
 229      endif
 230      call h5dcreate_f(DH%TgroupIDs(TimeIndex),DatasetName,FieldType,fspace_id,dset_id,&
 231           hdf5err,crp_list)
 232      call h5pclose_f(crp_list,hdf5err)
 233   else
 234      call h5dcreate_f(DH%TgroupIDs(TimeIndex),DatasetName,FieldType,fspace_id,dset_id,hdf5err)
 235   endif
 236
 237   if(hdf5err.lt.0) then
 238      Status =  WRF_HDF5_ERR_DATASET_CREATE
 239      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 240      call wrf_debug ( WARN , msg)
 241      deallocate(dims)
 242      deallocate(count)
 243      deallocate(offset)
 244      deallocate(sizes)
 245      return
 246   endif
 247
 248   ! select the correct hyperslab for file space id
 249   CALL h5sselect_hyperslab_f(fspace_id, H5S_SELECT_SET_F, offset, count &
 250        ,hdf5err)
 251   if(hdf5err.lt.0) then
 252      Status =  WRF_HDF5_ERR_DATASET_GENERAL
 253      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 254      call wrf_debug ( WARN , msg)
 255      deallocate(dims)
 256      deallocate(count)
 257      deallocate(offset)
 258      deallocate(sizes)
 259      return
 260   endif
 261
 262   ! Create property list for collective dataset write
 263   CALL h5pcreate_f(H5P_DATASET_XFER_F, xfer_list, hdf5err)
 264   if(hdf5err.lt.0) then
 265      Status =  WRF_HDF5_ERR_PROPERTY_LIST
 266      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 267      call wrf_debug ( WARN , msg)
 268      deallocate(dims)
 269      deallocate(count)
 270      deallocate(offset)
 271      deallocate(sizes)
 272      return
 273   endif
 274
 275   CALL h5pset_dxpl_mpio_f(xfer_list, H5FD_MPIO_COLLECTIVE_F&
 276        ,hdf5err)
 277   if(hdf5err.lt.0) then
 278      Status =  WRF_HDF5_ERR_PROPERTY_LIST
 279      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 280      call wrf_debug ( WARN , msg)
 281      deallocate(dims)
 282      deallocate(count)
 283      deallocate(offset)
 284      deallocate(sizes)
 285      return
 286   endif
 287
 288
 289   ! write the data in memory space to file space
 290   CALL h5dwrite_f(dset_id,FieldType,XField,dimsfi,hdf5err,&
 291        mem_space_id =dspace_id,file_space_id =fspace_id, &
 292        xfer_prp = xfer_list)
 293   if(hdf5err.lt.0) then
 294      Status =  WRF_HDF5_ERR_DATASET_WRITE
 295      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 296      call wrf_debug ( WARN , msg)
 297      deallocate(dims)
 298      deallocate(count)
 299      deallocate(offset)
 300      deallocate(sizes)
 301      return
 302   endif
 303
 304   CALL h5pclose_f(xfer_list,hdf5err)
 305   if(hdf5err.lt.0) then
 306      Status =  WRF_HDF5_ERR_PROPERTY_LIST
 307      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 308      call wrf_debug ( WARN , msg)
 309      deallocate(dims)
 310      deallocate(count)
 311      deallocate(offset)
 312      deallocate(sizes)
 313      return
 314   endif
 315
 316   if(TimeIndex == 1) then
 317      do i =1, MaxVars
 318         if(DH%dsetids(i) == -1) then
 319            DH%dsetids(i) = dset_id
 320            DH%VarNames(i) = DataSetName
 321            exit
 322         endif
 323      enddo
 324      ! Only writing attributes when TimeIndex ==1
 325      call write_hdf5_attributes(DataHandle,MemoryOrder,WrfDType,DimRank,&
 326           NDim,dset_id,Status)
 327   endif
 328
 329   call h5sclose_f(fspace_id,hdf5err)
 330   call h5sclose_f(dspace_id,hdf5err)
 331   if(TimeIndex /= 1) then
 332      call h5dclose_f(dset_id,hdf5err)
 333   endif
 334   if(hdf5err.lt.0) then
 335      Status =  WRF_HDF5_ERR_DATASPACE
 336      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 337      call wrf_debug ( WARN , msg)
 338      deallocate(dims)
 339      deallocate(count)
 340      deallocate(offset)
 341      deallocate(sizes)
 342      return
 343   endif
 344   Status = WRF_NO_ERR
 345   return
 346 end subroutine  HDF5IOWRITE
 347
 348
 349 subroutine ext_phdf5_ioinit(SysDepInfo, Status)
 350
 351   use wrf_phdf5_data
 352   use HDF5
 353   implicit none
 354
 355   include 'wrf_status_codes.h'
 356   include 'mpif.h'
 357
 358   CHARACTER*(*), INTENT(IN) :: SysDepInfo
 359   integer, intent(out) :: status
 360   integer              :: hdf5err
 361
 362   ! set up some variables inside the derived type
 363   WrfDataHandles(1:WrfDataHandleMax)%Free = .true.
 364   ! ?
 365   WrfDataHandles(1:WrfDataHandleMax)%TimesName    = 'Times'
 366   WrfDataHandles(1:WrfDataHandleMax)%DimUnlimName = 'Time'
 367
 368   ! set up HDF5 global variables
 369   call h5open_f(hdf5err)
 370   if(hdf5err .lt.0) then
 371      Status =  WRF_HDF5_ERR_CLOSE_GENERAL
 372      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 373      call wrf_debug ( WARN , msg)
 374      return
 375   endif
 376   return
 377 end subroutine ext_phdf5_ioinit
 378
 379
 380 subroutine ext_phdf5_ioclose( DataHandle, Status)
 381
 382   use wrf_phdf5_data
 383   use ext_phdf5_support_routines
 384   use hdf5
 385   implicit none
 386   include 'wrf_status_codes.h'
 387   include 'mpif.h'
 388
 389   integer              ,intent(in)       :: DataHandle
 390   integer              ,intent(out)      :: Status
 391   type(wrf_phdf5_data_handle),pointer     :: DH
 392   integer                                :: stat
 393   integer                                :: NVar
 394   integer                                :: hdferr
 395   integer                                :: table_length
 396   integer                                :: i
 397   integer(hid_t)                         :: dtype_id
 398   integer                                :: obj_count
 399   integer(hid_t),allocatable,dimension(:) :: obj_ids
 400   character(len=100)                       :: buf
 401   integer(size_t)                        :: name_size
 402
 403   call GetDH(DataHandle,DH,Status)
 404   if(Status /= WRF_NO_ERR) then
 405      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', 906
 406      call wrf_debug ( WARN , msg)
 407      return
 408   endif
 409
 410   ! THE FOLLOWING section writes dimscale information to the data set,may be put into a subroutine
 411
 412   ! check the file status, should be either open_for_read or opened_and_committed
 413   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
 414      Status = WRF_HDF5_ERR_FILE_OPEN
 415      write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
 416      call wrf_debug ( WARN , msg)
 417   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
 418      Status = WRF_HDF5_ERR_DRYRUN_CLOSE
 419      write(msg,*) 'Warning TRY TO CLOSE DRYRUN in ',__FILE__,', line', __LINE__
 420      call wrf_debug ( WARN , msg)
 421
 422   elseif(DH%FileStatus == WRF_FILE_OPENED_AND_COMMITTED) then
 423      ! Handle dim. scale
 424      ! STORE "Times" as the first element of the dimensional table
 425
 426      DH%DIMTABLE(1)%dim_name  = 'Time'
 427      DH%DIMTABLE(1)%Length    = DH%TimeIndex
 428      DH%DIMTABLE(1)%unlimited = 1
 429
 430      do i =1,MaxTabDims
 431         if(DH%DIMTABLE(i)%dim_name== NO_NAME) then
 432            exit
 433         endif
 434      enddo
 435
 436      table_length = i-1
 437      call store_table(DataHandle,table_length,Status)
 438      if(Status.ne.WRF_NO_ERR) then
 439         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 440         call wrf_debug ( WARN , msg)
 441         return
 442      endif
 443      continue
 444   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
 445      !     call h5dclose_f(DH%TimesID,hdferr)
 446      !     if(hdferr.lt.0) then
 447      !       Status =  WRF_HDF5_ERR_DATASET_CLOSE
 448      !       write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 449      !       call wrf_debug ( WARN , msg)
 450      !       return
 451      !     endif
 452      continue
 453   else
 454      Status = WRF_HDF5_ERR_BAD_FILE_STATUS
 455      write(msg,*) 'Fatal hdf5err BAD FILE STATUS in ',__FILE__,', line', __LINE__
 456      call wrf_debug ( FATAL , msg)
 457      return
 458   endif
 459
 460   ! close HDF5 APIs
 461   do NVar = 1, MaxVars
 462      if(DH%DsetIDs(NVar) /= -1) then
 463         call h5dclose_f(DH%DsetIDs(NVar),hdferr)
 464         if(hdferr .ne. 0) then
 465            Status =  WRF_HDF5_ERR_DATASET_CLOSE
 466            write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 467            call wrf_debug ( WARN , msg)
 468            return
 469         endif
 470      endif
 471   enddo
 472
 473   do i = 1, MaxTimes
 474      if(DH%TgroupIDs(i) /= -1) then
 475         call h5gclose_f(DH%TgroupIDs(i),hdferr)
 476         if(hdferr .ne. 0) then
 477            Status =  WRF_HDF5_ERR_DATASET_CLOSE
 478            write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 479            call wrf_debug ( WARN , msg)
 480            return
 481         endif
 482      endif
 483   enddo
 484
 485   call h5gclose_f(DH%GroupID,hdferr)
 486   if(hdferr .ne. 0) then
 487      Status =  WRF_HDF5_ERR_CLOSE_GENERAL
 488      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 489      call wrf_debug ( WARN , msg)
 490      return
 491   endif
 492
 493   call h5gclose_f(DH%DimGroupID,hdferr)
 494   if(hdferr .ne. 0) then
 495      Status =  WRF_HDF5_ERR_CLOSE_GENERAL
 496      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 497      call wrf_debug ( WARN , msg)
 498      return
 499   endif
 500
 501   if(Status /= WRF_NO_ERR) then
 502      write(msg,*) 'HDF5 IO CLOSE error in ',__FILE__,', line', __LINE__
 503      call wrf_debug ( WARN , msg)
 504      return
 505   endif
 506
 507   call h5fclose_f(DH%FileID,hdferr)
 508   if(hdferr .ne. 0) then
 509      Status =  WRF_HDF5_ERR_CLOSE_GENERAL
 510      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 511      call wrf_debug ( WARN , msg)
 512      return
 513   endif
 514
 515   if(Status /= WRF_NO_ERR) then
 516      write(msg,*) 'HDF5 IO CLOSE error in ',__FILE__,', line', __LINE__
 517      call wrf_debug ( WARN , msg)
 518      return
 519   endif
 520
 521   call free_memory(DataHandle,Status)
 522   if(Status /= WRF_NO_ERR) then
 523      Status = WRF_HDF5_ERR_OTHERS
 524      write(msg,*) 'Warning Status = ',__FILE__,', line', __LINE__
 525      call wrf_debug ( WARN , msg)
 526      return
 527   endif
 528
 529   DH%Free=.true.
 530   return
 531 end subroutine ext_phdf5_ioclose
 532
 533
 534 subroutine ext_phdf5_ioexit(Status)
 535
 536   use wrf_phdf5_data
 537   use ext_phdf5_support_routines
 538   use HDF5
 539   implicit none
 540   include 'wrf_status_codes.h'
 541   include 'mpif.h'
 542
 543   integer              ,intent(out)      :: Status
 544   integer                                :: hdf5err
 545   type(wrf_phdf5_data_handle),pointer     :: DH
 546   integer                                :: i
 547   integer                                :: stat
 548
 549
 550   ! free memories
 551   do i=1,WrfDataHandleMax
 552      if(.not.WrfDataHandles(i)%Free) then
 553         call free_memory(i,Status)
 554         exit
 555      endif
 556   enddo
 557
 558   if(Status /= WRF_NO_ERR) then
 559      write(msg,*) 'free resources error in ',__FILE__,', line', __LINE__
 560      call wrf_debug ( WARN , msg)
 561      return
 562   endif
 563
 564   CALL h5close_f(hdf5err)
 565
 566   if(hdf5err.lt.0) then
 567      Status = WRF_HDF5_ERR_CLOSE_GENERAL
 568      write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
 569      call wrf_debug ( FATAL , msg)
 570      return
 571   endif
 572
 573   return
 574 end subroutine ext_phdf5_ioexit
 575
 576
 577
 578 !! This routine will set up everything to read HDF5 files
 579 subroutine ext_phdf5_open_for_read(FileName,Comm,iocomm,SysDepInfo,DataHandle,Status)
 580
 581   use wrf_phdf5_data
 582   use ext_phdf5_support_routines
 583   use HDF5
 584   implicit none
 585   include 'mpif.h'
 586   include 'wrf_status_codes.h'
 587
 588   character*(*),intent(in)                     :: FileName
 589   integer      ,intent(in)                     :: Comm
 590   integer      ,intent(in)                     :: iocomm
 591   character*(*),intent(in)                     :: SysDepInfo
 592   integer      ,intent(out)                    :: DataHandle
 593   type(wrf_phdf5_data_handle),pointer          :: DH
 594   integer      ,intent(out)                    :: Status
 595
 596   integer(hid_t)                               :: Fileid
 597   integer(hid_t)                               :: tgroupid
 598   integer(hid_t)                               :: dsetid
 599   integer(hid_t)                               :: dspaceid
 600   integer(hid_t)                               :: dtypeid
 601   integer(hid_t)                               :: acc_plist
 602   integer                                      :: nmembers
 603   integer                                      :: submembers
 604   integer                                      :: tmembers
 605   integer                                      :: ObjType
 606   character(len= 256)                           :: ObjName
 607   character(len= 256)                           :: GroupName
 608
 609   integer                                      :: i,j
 610   integer(hsize_t), dimension(7)               :: data_dims
 611   integer(hsize_t), dimension(1)               :: h5dims
 612   integer(hsize_t), dimension(1)               :: h5maxdims
 613   integer                                      :: StoredDim
 614   integer                                      :: NumVars
 615
 616   integer                                      :: hdf5err
 617   integer                                      :: info,mpi_size,mpi_rank
 618   character(Len = MaxTimeSLen)                 :: tname
 619   character(Len = 512)                         :: tgroupname
 620
 621
 622   ! Allocating the data handle
 623   call allocHandle(DataHandle,DH,Comm,Status)
 624   if(Status /= WRF_NO_ERR) then
 625      return
 626   endif
 627
 628   call h5pcreate_f(H5P_FILE_ACCESS_F,acc_plist,hdf5err)
 629   if(hdf5err.lt.0) then
 630      Status =  WRF_HDF5_ERR_PROPERTY_LIST
 631      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 632      call wrf_debug ( WARN , msg)
 633      return
 634   endif
 635
 636   info = MPI_INFO_NULL
 637   CALL h5pset_fapl_mpio_f(acc_plist, comm, info, hdf5err)
 638   !   call h5pset_fapl_mpiposix_f(acc_plist,comm,.false.,hdf5err)
 639   if(hdf5err .lt. 0) then
 640      Status = WRF_HDF5_ERR_PROPERTY_LIST
 641      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 642      call wrf_debug ( WARN , msg)
 643      return
 644   endif
 645   !close every objects when closing HDF5 file.
 646   call h5pset_fclose_degree_f(acc_plist,H5F_CLOSE_STRONG_F,hdf5err)
 647   if(hdf5err .lt. 0) then
 648      Status = WRF_HDF5_ERR_PROPERTY_LIST
 649      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 650      call wrf_debug ( WARN , msg)
 651      return
 652   endif
 653
 654
 655   ! Open the file
 656   call h5fopen_f(FileName,H5F_ACC_RDWR_F,Fileid,hdf5err &
 657        ,acc_plist)
 658   if(hdf5err.lt.0) then
 659      Status =  WRF_HDF5_ERR_FILE_OPEN
 660      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 661      call wrf_debug ( WARN , msg)
 662      return
 663   endif
 664   call h5pclose_f(acc_plist,hdf5err)
 665   if(hdf5err .lt. 0) then
 666      Status = WRF_HDF5_ERR_PROPERTY_LIST
 667      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 668      call wrf_debug ( WARN , msg)
 669      return
 670   endif
 671
 672
 673   ! Obtain the number of group
 674   DH%FileID = Fileid
 675   call h5gn_members_f(Fileid,"/",nmembers,hdf5err)
 676   if(hdf5err.lt.0) then
 677      Status = WRF_HDF5_ERR_GROUP
 678      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 679      call wrf_debug ( WARN , msg)
 680      return
 681   endif
 682
 683   ! Retrieve group id and dimensional group id, the index must be from 0
 684   do i = 0, nmembers - 1
 685      call h5gget_obj_info_idx_f(Fileid,"/",i,ObjName,ObjType,&
 686           hdf5err)
 687      if(hdf5err.lt.0) then
 688         Status = WRF_HDF5_ERR_GROUP
 689         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 690         call wrf_debug ( WARN , msg)
 691         return
 692      endif
 693
 694      if(ObjName=='DIM_GROUP') then
 695
 696         call h5gopen_f(Fileid,"/DIM_GROUP",DH%DimGroupID,hdf5err)
 697         if(hdf5err.lt.0) then
 698            Status = WRF_HDF5_ERR_GROUP
 699            write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 700            call wrf_debug ( WARN , msg)
 701            return
 702         endif
 703
 704         ! For WRF model, the first seven character must be DATASET
 705      else if(ObjName(1:7)=='DATASET')then
 706
 707         GroupName="/"//ObjName
 708         call h5gopen_f(Fileid,GroupName,DH%GroupID,hdf5err)
 709         if(hdf5err.lt.0) then
 710            Status = WRF_HDF5_ERR_GROUP
 711            write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 712            call wrf_debug ( WARN , msg)
 713            return
 714         endif
 715
 716         call h5gn_members_f(FileID,GroupName,submembers,Status)
 717         if(hdf5err.lt.0) then
 718            Status = WRF_HDF5_ERR_GROUP
 719            write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 720            call wrf_debug ( WARN , msg)
 721            return
 722         endif
 723
 724         do j = 0, submembers -1
 725            call h5gget_obj_info_idx_f(Fileid,GroupName,j,ObjName,ObjType,hdf5err)
 726            if(hdf5err.lt.0) then
 727               Status = WRF_HDF5_ERR_GROUP
 728               write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 729               call wrf_debug ( WARN , msg)
 730               return
 731            endif
 732            call numtochar(j+1,tname)
 733            tgroupname = 'TIME_STAMP_'//tname
 734
 735            if(ObjName(1:17)==tgroupname) then
 736               call h5gopen_f(DH%GroupID,tgroupname,tgroupid,hdf5err)
 737               if(hdf5err.lt.0) then
 738                  Status = WRF_HDF5_ERR_GROUP
 739                  write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 740                  call wrf_debug ( WARN , msg)
 741                  return
 742               endif
 743               call h5gn_members_f(DH%GroupID,tgroupname,tmembers,hdf5err)
 744               if(hdf5err.lt.0) then
 745                  Status = WRF_HDF5_ERR_GROUP
 746                  write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 747                  call wrf_debug ( WARN , msg)
 748                  return
 749               endif
 750               call h5dopen_f(tgroupid,"Times",dsetid,hdf5err)
 751               if(hdf5err.lt.0) then
 752                  Status = WRF_HDF5_ERR_DATASET_OPEN
 753                  write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 754                  call wrf_debug ( WARN , msg)
 755                  return
 756               endif
 757               call h5dget_space_f(dsetid,dspaceid,hdf5err)
 758               if(hdf5err.lt.0) then
 759                  Status = WRF_HDF5_ERR_DATASPACE
 760                  write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 761                  call wrf_debug ( WARN , msg)
 762                  return
 763               endif
 764               call h5sget_simple_extent_ndims_f(dspaceid,StoredDim,hdf5err)
 765               if(hdf5err.lt.0) then
 766                  Status = WRF_HDF5_ERR_DATASPACE
 767                  write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 768                  call wrf_debug ( WARN , msg)
 769                  return
 770               endif
 771               call h5sget_simple_extent_dims_f(dspaceid,h5dims,h5maxdims,hdf5err)
 772               if(hdf5err.lt.0) then
 773                  Status = WRF_HDF5_ERR_DATASPACE
 774                  write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 775                  call wrf_debug ( WARN , msg)
 776                  return
 777               endif
 778               data_dims(1) = h5dims(1)
 779               call h5dget_type_f(dsetid,dtypeid,hdf5err)
 780               if(hdf5err.lt.0) then
 781                  Status = WRF_HDF5_ERR_DATATYPE
 782                  write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 783                  call wrf_debug ( WARN , msg)
 784                  return
 785               endif
 786               call h5dread_f(dsetid,dtypeid,DH%Times(j+1),data_dims,hdf5err)
 787               if(hdf5err.lt.0) then
 788                  Status = WRF_HDF5_ERR_DATASET_READ
 789                  write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 790                  call wrf_debug ( WARN , msg)
 791                  return
 792               endif
 793               DH%CurrentVariable = 0
 794               DH%CurrentTime     = 0
 795               DH%TimeIndex       = 0
 796               call h5tclose_f(dtypeid,hdf5err)
 797               call h5sclose_f(dspaceid,hdf5err)
 798            endif
 799         enddo
 800         DH%NumberTimes = submembers
 801
 802         !       the total member of HDF5 dataset.
 803         DH%NumVars = tmembers*submembers
 804      else
 805         Status = WRF_HDF5_ERR_OTHERS
 806      endif
 807   enddo
 808
 809   DH%FileStatus      = WRF_FILE_OPENED_FOR_READ
 810   DH%FileName        = FileName
 811
 812   ! obtain dimensional scale table
 813   call retrieve_table(DataHandle,Status)
 814   if(Status /= WRF_NO_ERR) then
 815      return
 816   endif
 817   return
 818
 819 end subroutine ext_phdf5_open_for_read
 820
 821
 822 subroutine ext_phdf5_inquire_opened(DataHandle,FileName,FileStatus,Status)
 823
 824   use wrf_phdf5_data
 825   use ext_phdf5_support_routines
 826   use HDF5
 827   implicit none
 828   include 'wrf_status_codes.h'
 829   integer                    ,intent(in)     :: DataHandle
 830   character*(*)              ,intent(in)     :: FileName
 831   integer                    ,intent(out)    :: FileStatus
 832   integer                    ,intent(out)    :: Status
 833   type(wrf_phdf5_data_handle) ,pointer       :: DH
 834
 835
 836   call GetDH(DataHandle,DH,Status)
 837   if(Status /= WRF_NO_ERR) then
 838      FileStatus = WRF_FILE_NOT_OPENED
 839      return
 840   endif
 841   if(FileName /= DH%FileName) then
 842      FileStatus = WRF_FILE_NOT_OPENED
 843   else
 844      FileStatus = DH%FileStatus
 845   endif
 846   Status = WRF_NO_ERR
 847   return
 848 end subroutine ext_phdf5_inquire_opened
 849
 850
 851 subroutine ext_phdf5_inquire_filename(DataHandle,FileName,FileStatus,Status)
 852
 853   use wrf_phdf5_data
 854   use ext_phdf5_support_routines
 855   use HDF5
 856   implicit none
 857   include 'wrf_status_codes.h'
 858
 859   integer               ,intent(in)     :: DataHandle
 860   character*(*)         ,intent(out)     :: FileName
 861   integer               ,intent(out)    :: FileStatus
 862   integer               ,intent(out)    :: Status
 863   type(wrf_phdf5_data_handle) ,pointer        :: DH
 864
 865   ! This line is added to make sure the wrong file will not be opened
 866   FileStatus = WRF_FILE_NOT_OPENED
 867
 868   call GetDH(DataHandle,DH,Status)
 869   if(Status /= WRF_NO_ERR) then
 870      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,',line',__LINE__
 871      call wrf_debug (WARN, msg)
 872      return
 873   endif
 874
 875   FileName = DH%FileName
 876   FileStatus = DH%FileStatus
 877   Status = WRF_NO_ERR
 878
 879   return
 880 end subroutine ext_phdf5_inquire_filename
 881
 882
 883 ! The real routine to read HDF5 files
 884 subroutine ext_phdf5_read_field(DataHandle,DateStr,Var,Field,FieldType,Comm,  &
 885      IOComm, DomainDesc, MemoryOrder, Stagger, DimNames, &
 886      DomainStart,DomainEnd,MemoryStart,MemoryEnd, &
 887      PatchStart,PatchEnd,Status)
 888
 889   use wrf_phdf5_data
 890   use ext_phdf5_support_routines
 891   use HDF5
 892
 893   implicit none
 894   include 'wrf_status_codes.h'
 895   integer                       ,intent(in)    :: DataHandle
 896   character*(*)                 ,intent(in)    :: DateStr
 897   character*(*)                 ,intent(in)    :: Var
 898   integer                       ,intent(out)   :: Field(*)
 899   integer                       ,intent(in)    :: FieldType
 900   integer                       ,intent(inout) :: Comm
 901   integer                       ,intent(inout) :: IOComm
 902   integer                       ,intent(in)    :: DomainDesc
 903   character*(*)                 ,intent(in)    :: MemoryOrder
 904   character*(*)                 ,intent(in)    :: Stagger ! Dummy for now
 905   character*(*) , dimension (*) ,intent(in)    :: DimNames
 906   integer ,dimension(*)         ,intent(in)    :: DomainStart, DomainEnd
 907   integer ,dimension(*)         ,intent(in)    :: MemoryStart, MemoryEnd
 908   integer ,dimension(*)         ,intent(in)    :: PatchStart,  PatchEnd
 909   integer                       ,intent(out)   :: Status
 910
 911   type(wrf_phdf5_data_handle)    ,pointer       :: DH
 912   integer                                      :: NDim
 913   integer(hid_t)                               :: GroupID
 914   character (VarNameLen)                       :: VarName
 915   integer ,dimension(NVarDims)                 :: Length
 916   integer ,dimension(NVarDims)                 :: StoredStart
 917   integer ,dimension(NVarDims)                 :: StoredLen
 918   integer, dimension(NVarDims)                 :: TemDataStart
 919   integer ,dimension(:,:,:,:)  ,allocatable    :: XField
 920   integer                                      :: NVar
 921   integer                                      :: j
 922   integer                                      :: i1,i2,j1,j2,k1,k2
 923   integer                                      :: x1,x2,y1,y2,z1,z2
 924   integer                                      :: l1,l2,m1,m2,n1,n2
 925   character (VarNameLen)                       :: Name
 926   integer                                      :: XType
 927   integer                                      :: StoredDim
 928   integer                                      :: NAtts
 929   integer                                      :: Len
 930   integer                                      :: stat
 931   integer                                      :: di
 932   integer                                      :: FType
 933   integer(hsize_t),dimension(7)                :: data_dims
 934   integer(hsize_t),dimension(:) ,allocatable   :: h5_dims
 935   integer(hsize_t),dimension(:) ,allocatable   :: h5_maxdims
 936   integer(hsize_t),dimension(:) ,allocatable   :: DataStart
 937   integer(hsize_t),dimension(:) ,allocatable   :: Datacount
 938   integer(hid_t)                               :: tgroupid
 939   integer(hid_t)                               :: dsetid
 940   integer(hid_t)                               :: dtype_id
 941   integer(hid_t)                               :: dmemtype_id
 942   integer(hid_t)                               :: dspace_id
 943   integer(hid_t)                               :: memspace_id
 944   integer                                      :: class_type
 945   integer                                      :: TimeIndex
 946   logical                                      :: flag
 947   integer                                      :: hdf5err
 948
 949   character(Len = MaxTimeSLen)                 :: tname
 950   character(Len = 512)                         :: tgroupname
 951
 952
 953   ! FOR PARALLEL IO
 954   integer                                      :: mpi_rank
 955   integer(hid_t)                               :: xfer_list
 956
 957
 958   call GetDH(DataHandle,DH,Status)
 959   if(Status /= WRF_NO_ERR) then
 960      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 961      call wrf_debug ( WARN , msg)
 962      return
 963   endif
 964
 965   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
 966      Status = WRF_HDF5_ERR_FILE_NOT_OPENED
 967      write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
 968      call wrf_debug ( WARN , msg)
 969   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
 970      Status = WRF_HDF5_ERR_DRYRUN_READ
 971      write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__
 972      call wrf_debug ( WARN , msg)
 973   elseif(DH%FileStatus == WRF_FILE_OPENED_AND_COMMITTED) then
 974      Status = WRF_HDF5_ERR_READ_WONLY_FILE
 975      write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__
 976      call wrf_debug ( WARN , msg)
 977   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
 978
 979      ! obtain TimeIndex
 980      call GetDataTimeIndex('read',DataHandle,DateStr,TimeIndex,Status)
 981
 982      ! obtain the absolute name of the group where the dataset is located
 983      call numtochar(TimeIndex,tname)
 984      tgroupname = 'TIME_STAMP_'//tname
 985
 986      call h5gopen_f(DH%GroupID,tgroupname,tgroupid,hdf5err)
 987      if(hdf5err.lt.0) then
 988         Status = WRF_HDF5_ERR_GROUP
 989         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 990         call wrf_debug ( WARN , msg)
 991         return
 992      endif
 993
 994      call h5dopen_f(tgroupid,Var,dsetid,hdf5err)
 995      if(hdf5err.lt.0) then
 996         Status = WRF_HDF5_ERR_DATASET_OPEN
 997         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 998         call wrf_debug ( WARN , msg)
 999         return
1000      endif
1001
1002      ! Obtain the memory datatype
1003      select case(FieldType)
1004      case (WRF_REAL)
1005         dmemtype_id = H5T_NATIVE_REAL
1006      case (WRF_DOUBLE)
1007         dmemtype_id = H5T_NATIVE_DOUBLE
1008      case (WRF_INTEGER)
1009         dmemtype_id = H5T_NATIVE_INTEGER
1010      case (WRF_LOGICAL)
1011         dmemtype_id = DH%EnumID
1012      case default
1013         Status = WRF_HDF5_ERR_DATA_TYPE_NOTFOUND
1014         write(msg,*) 'Warning BAD Memory Data type in ',__FILE__,',line',__LINE__
1015         call wrf_debug(WARN,msg)
1016         return
1017      end select
1018
1019      ! Obtain the datatype
1020      call h5dget_type_f(dsetid,dtype_id,hdf5err)
1021      if(hdf5err.lt.0) then
1022         Status = WRF_HDF5_ERR_DATATYPE
1023         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
1024         call wrf_debug ( WARN , msg)
1025         return
1026      endif
1027
1028      ! double check whether the Fieldtype is the type of the dataset
1029      ! we may do the force coercion between real and double
1030      call h5tget_class_f(dtype_id,class_type,hdf5err)
1031      if(hdf5err.lt.0) then
1032         Status = WRF_HDF5_ERR_DATATYPE
1033         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
1034         call wrf_debug ( WARN , msg)
1035         return
1036      endif
1037
1038      if( (FieldType == WRF_REAL .OR. FieldType == WRF_DOUBLE) ) then
1039         if ( class_type /= H5T_FLOAT_F)  then
1040            Status = WRF_HDF5_ERR_TYPE_MISMATCH
1041            write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
1042            call wrf_debug ( WARN , msg)
1043            return
1044         endif
1045      else if(FieldType == WRF_CHARACTER) then
1046         if(class_type /= H5T_STRING_F) then
1047            Status = WRF_HDF5_ERR_TYPE_MISMATCH
1048            write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
1049            call wrf_debug ( WARN , msg)
1050            return
1051         endif
1052      else if(FieldType == WRF_INTEGER) then
1053         if(class_type /= H5T_INTEGER_F) then
1054            Status = WRF_HDF5_ERR_TYPE_MISMATCH
1055            write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
1056            call wrf_debug ( WARN , msg)
1057            return
1058         endif
1059      else if(FieldType == WRF_LOGICAL) then
1060         if(class_type /= H5T_ENUM_F) then
1061            Status = WRF_HDF5_ERR_TYPE_MISMATCH
1062            write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
1063            call wrf_debug ( WARN , msg)
1064            return
1065         endif
1066         call h5tequal_f(dtype_id,DH%EnumID,flag,hdf5err)
1067         if(hdf5err.lt.0) then
1068            Status = WRF_HDF5_ERR_DATASET_OPEN
1069            write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
1070            call wrf_debug ( WARN , msg)
1071            return
1072         endif
1073         if(flag .EQV. .FALSE.) then
1074            Status = WRF_HDF5_ERR_TYPE_MISMATCH
1075            write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
1076            call wrf_debug ( WARN , msg)
1077            return
1078         endif
1079      else
1080         Status = WRF_HDF5_ERR_BAD_DATA_TYPE
1081         write(msg,*)'Fatal Non-WRF supported TYPE in ',__FILE__,', line',__LINE__
1082         call wrf_debug(FATAL, msg)
1083         return
1084      endif
1085
1086      ! Obtain the dataspace, check whether the dataspace is within the range
1087      ! transpose the memory order to the disk order
1088      call h5dget_space_f(dsetid,dspace_id,hdf5err)
1089      if(hdf5err.lt.0) then
1090         Status = WRF_HDF5_ERR_DATASPACE
1091         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
1092         call wrf_debug ( WARN , msg)
1093         return
1094      endif
1095
1096      call GetDim(MemoryOrder,NDim,Status)
1097
1098      Length(1:NDim) = PatchEnd(1:NDim)-PatchStart(1:NDim)+1
1099      call ExtOrder(MemoryOrder,Length,Status)
1100
1101      ! Obtain the rank of the dimension
1102      call h5sget_simple_extent_ndims_f(dspace_id,StoredDim,hdf5err)
1103      if(hdf5err.lt.0) then
1104         Status = WRF_HDF5_ERR_DATASPACE
1105         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
1106         call wrf_debug ( WARN , msg)
1107         return
1108      endif
1109
1110      ! From NetCDF implementation, only do error handling
1111      if((NDim+1) /= StoredDim) then
1112         Status = WRF_HDF5_ERR_BAD_VARIABLE_DIM
1113         write(msg,*) 'Fatal error BAD VARIABLE DIMENSION in ',__FILE__,', line', __LINE__
1114         call wrf_debug ( FATAL , msg)
1115         return
1116      endif
1117      allocate(h5_dims(StoredDim))
1118      allocate(h5_maxdims(StoredDim))
1119      allocate(DataStart(StoredDim))
1120      allocate(DataCount(StoredDim))
1121
1122      call h5sget_simple_extent_dims_f(dspace_id,h5_dims,h5_maxdims,hdf5err)
1123      if(hdf5err.lt.0) then
1124         Status = WRF_HDF5_ERR_DATASPACE
1125         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
1126         call wrf_debug ( WARN , msg)
1127         return
1128      endif
1129
1130      ! This part of code needs to be adjusted, currently use NetCDF convention
1131      do j = 1, NDim
1132         if(Length(j) > h5_dims(j)) then
1133            Status = WRF_HDF5_ERR_READ_PAST_EOF
1134            write(msg,*) 'Warning READ PAST EOF in ',__FILE__,', line', __LINE__
1135            call wrf_debug ( WARN , msg)
1136            return
1137         elseif(Length(j) <= 0) then
1138            Status = WRF_HDF5_ERR_ZERO_LENGTH_READ
1139            write(msg,*) 'Warning ZERO LENGTH READ in ',__FILE__,', line', __LINE__
1140            call wrf_debug ( WARN , msg)
1141            return
1142         endif
1143      enddo
1144
1145      ! create memspace_id
1146      data_dims(1:NDim) = Length(1:NDim)
1147      data_dims(NDim+1) = 1
1148
1149      call h5screate_simple_f(NDim+1,data_dims,memspace_id,hdf5err)
1150      if(hdf5err.lt.0) then
1151         Status = WRF_HDF5_ERR_DATASPACE
1152         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
1153         call wrf_debug ( WARN , msg)
1154         return
1155      endif
1156
1157      ! DataStart can start from PatchStart.
1158      TEMDataStart(1:NDim) = PatchStart(1:NDim)-1
1159
1160      if(MemoryOrder.NE.'0') then
1161         call ExtOrder(MemoryOrder,TEMDataStart,Status)
1162      endif
1163
1164      DataStart(1:NDim) = TEMDataStart(1:NDim)
1165      DataStart(NDim+1) = 0
1166      DataCount(1:NDim) = Length(1:NDim)
1167      DataCount(NDim+1) = 1
1168
1169      ! transpose the data XField to Field
1170      call GetIndices(NDim,MemoryStart,MemoryEnd,l1,l2,m1,m2,n1,n2)
1171      StoredStart = 1
1172      StoredLen(1:NDim) = Length(1:NDim)
1173
1174      ! the dimensional information inside the disk may be greater than
1175      ! the dimension(PatchEnd-PatchStart); here we can speed up
1176      ! the performance by using hyperslab selection
1177      call GetIndices(NDim,StoredStart,StoredLen,x1,x2,y1,y2,z1,z2)
1178      call GetIndices(NDim,PatchStart,PatchEnd,i1,i2,j1,j2,k1,k2)
1179
1180      ! di is for double type data
1181      di = 1
1182      if(FieldType == WRF_DOUBLE) di = 2
1183      allocate(XField(di,x1:x2,y1:y2,z1:z2), STAT=stat)
1184
1185      ! use hyperslab to only read this current timestamp
1186      call h5sselect_hyperslab_f(dspace_id,H5S_SELECT_SET_F, &
1187           DataStart,DataCount,hdf5err)
1188      if(hdf5err.lt.0) then
1189         Status = WRF_HDF5_ERR_DATASET_GENERAL
1190         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
1191         call wrf_debug ( WARN , msg)
1192         return
1193      endif
1194
1195      ! read the data in this time stamp
1196      call h5dread_f(dsetid,dmemtype_id,XField,data_dims,hdf5err, &
1197           memspace_id,dspace_id,H5P_DEFAULT_F)
1198      if(hdf5err.lt.0) then
1199         Status = WRF_HDF5_ERR_DATASET_READ
1200         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
1201         call wrf_debug ( WARN , msg)
1202         return
1203      endif
1204
1205      call transpose_hdf5('read',MemoryOrder,di, Field,l1,l2,m1,m2,n1,n2 &
1206           ,XField,x1,x2,y1,y2,z1,z2 &
1207           ,i1,i2,j1,j2,k1,k2 )
1208
1209      deallocate(XField, STAT=stat)
1210      if(stat/= 0) then
1211         Status = WRF_HDF5_ERR_DEALLOCATION
1212         write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
1213         call wrf_debug ( FATAL , msg)
1214         return
1215      endif
1216
1217      call h5dclose_f(dsetid,hdf5err)
1218      if(hdf5err.lt.0) then
1219         Status = WRF_HDF5_ERR_DATASET_CLOSE
1220         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
1221         call wrf_debug ( WARN , msg)
1222         return
1223      endif
1224      deallocate(h5_dims)
1225      deallocate(h5_maxdims)
1226      deallocate(DataStart)
1227      deallocate(DataCount)
1228   else
1229      Status = WRF_HDF5_ERR_BAD_FILE_STATUS
1230      write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
1231      call wrf_debug ( FATAL , msg)
1232   endif
1233
1234   DH%first_operation  = .FALSE.
1235
1236   return
1237 end subroutine ext_phdf5_read_field
1238
1239 !! This routine essentially sets up everything to write HDF5 files
1240 SUBROUTINE ext_phdf5_open_for_write_begin(FileName,Comm,IOComm,SysDepInfo,DataHandle,Status)
1241
1242   use wrf_phdf5_data
1243   use HDF5
1244   use ext_phdf5_support_routines
1245   implicit none
1246   include 'mpif.h'
1247   include 'wrf_status_codes.h'
1248
1249   character*(*)        ,intent(in)            :: FileName
1250   integer              ,intent(in)            :: Comm
1251   integer              ,intent(in)            :: IOComm
1252   character*(*)        ,intent(in)            :: SysDepInfo
1253   integer              ,intent(out)           :: DataHandle
1254   integer              ,intent(out)           :: Status
1255   type(wrf_phdf5_data_handle),pointer          :: DH
1256   integer(hid_t)                              :: file5_id
1257   integer(hid_t)                              :: g_id
1258   integer(hid_t)                              :: gdim_id
1259   integer                                     :: hdferr
1260   integer                                     :: i
1261   integer                                     :: stat
1262   character (7)                               :: Buffer
1263   integer                                     :: VDimIDs(2)
1264   character(Len = 512)                        :: groupname
1265
1266   ! For parallel IO
1267   integer(hid_t)                              :: plist_id
1268   integer                                     :: hdf5_comm,info,mpi_size,mpi_rank
1269
1270
1271   call allocHandle(DataHandle,DH,Comm,Status)
1272   if(Status /= WRF_NO_ERR) then
1273      write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
1274      call wrf_debug ( FATAL , msg)
1275      return
1276   endif
1277   DH%TimeIndex = 0
1278   DH%Times     = ZeroDate
1279
1280   CALL h5pcreate_f(H5P_FILE_ACCESS_F, plist_id, hdferr)
1281   if(hdferr .lt. 0) then
1282      Status = WRF_HDF5_ERR_PROPERTY_LIST
1283      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
1284      call wrf_debug ( WARN , msg)
1285      return
1286   endif
1287
1288   info      = MPI_INFO_NULL
1289
1290   CALL h5pset_fapl_mpio_f(plist_id, comm, info, hdferr)
1291
1292   if(hdferr .lt. 0) then
1293      Status = WRF_HDF5_ERR_PROPERTY_LIST
1294      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
1295      call wrf_debug ( WARN , msg)
1296      return
1297   endif
1298
1299   call h5fcreate_f(FileName,H5F_ACC_TRUNC_F,file5_id,hdferr &
1300        ,access_prp = plist_id)
1301   if(hdferr .lt. 0) then
1302      Status = WRF_HDF5_ERR_FILE_CREATE
1303      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
1304      call wrf_debug ( WARN , msg)
1305      return
1306   endif
1307
1308   call h5pclose_f(plist_id,hdferr)
1309   if(hdferr .lt. 0) then
1310      Status = WRF_HDF5_ERR_PROPERTY_LIST
1311      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
1312      call wrf_debug ( WARN , msg)
1313      return
1314   endif
1315
1316   DH%FileStatus            = WRF_FILE_OPENED_NOT_COMMITTED
1317   DH%FileName              = FileName
1318   ! should add a check to see whether the file opened has been used by previous handles
1319   DH%VarNames  (1:MaxVars) = NO_NAME
1320   DH%MDVarNames(1:MaxVars) = NO_NAME
1321
1322   ! group name information is stored at SysDepInfo
1323   groupname = "/"//SysDepInfo
1324 !  write(*,*) "groupname ",groupname
1325   call h5gcreate_f(file5_id,groupname,g_id,hdferr)
1326   if(hdferr .lt. 0) then
1327      Status = WRF_HDF5_ERR_GROUP
1328      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
1329      call wrf_debug ( WARN , msg)
1330      return
1331   endif
1332
1333   ! create dimensional group id
1334   call h5gcreate_f(file5_id,"/DIM_GROUP",gdim_id,hdferr)
1335   if(hdferr .lt. 0) then
1336      Status = WRF_HDF5_ERR_GROUP
1337      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
1338      call wrf_debug ( WARN , msg)
1339      return
1340   endif
1341
1342   DH%FileID     = file5_id
1343   DH%GroupID    = g_id
1344   DH%DIMGroupID = gdim_id
1345
1346   return
1347
1348 end subroutine ext_phdf5_open_for_write_begin
1349
1350 ! HDF5 doesnot need this stage, basically this routine
1351 ! just updates the File status.
1352 SUBROUTINE ext_phdf5_open_for_write_commit(DataHandle, Status)
1353
1354   use wrf_phdf5_data
1355   use ext_phdf5_support_routines
1356   use HDF5
1357   implicit none
1358   include 'wrf_status_codes.h'
1359
1360   integer              ,intent(in)       :: DataHandle
1361   integer              ,intent(out)      :: Status
1362   type(wrf_phdf5_data_handle),pointer     :: DH
1363   integer(hid_t)                         :: enum_type
1364   integer                                :: i
1365   integer                                :: stat
1366
1367
1368   call GetDH(DataHandle,DH,Status)
1369   if(Status /= WRF_NO_ERR) then
1370      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
1371      call wrf_debug ( WARN , msg)
1372      return
1373   endif
1374
1375   DH%FileStatus  = WRF_FILE_OPENED_AND_COMMITTED
1376   DH%first_operation  = .TRUE.
1377   return
1378 end subroutine ext_phdf5_open_for_write_commit
1379
1380 ! The real routine to write HDF5 file
1381 subroutine ext_phdf5_write_field(DataHandle,DateStr,Var,Field,FieldType,&
1382      Comm,IOComm,DomainDesc,MemoryOrder,  &
1383      Stagger,DimNames,DomainStart,DomainEnd,&
1384      MemoryStart,MemoryEnd,PatchStart,PatchEnd,&
1385      Status)
1386
1387   use wrf_phdf5_data
1388   use ext_phdf5_support_routines
1389   USE HDF5 ! This module contains all necessary modules
1390   implicit none
1391   include 'wrf_status_codes.h'
1392
1393   integer                       ,intent(in)      :: DataHandle
1394   character*(*)                 ,intent(in)      :: DateStr
1395   character*(*)                 ,intent(in)      :: Var
1396   integer                       ,intent(inout)   :: Field(*)
1397   integer                       ,intent(in)      :: FieldType
1398   integer                       ,intent(inout)   :: Comm
1399   integer                       ,intent(inout)   :: IOComm
1400   integer                       ,intent(in)      :: DomainDesc
1401   character*(*)                 ,intent(in)      :: MemoryOrder
1402   character*(*)                 ,intent(in)      :: Stagger ! Dummy for now
1403   character*(*) , dimension (*) ,intent(in)      :: DimNames
1404   integer ,dimension(*)         ,intent(in)      :: DomainStart, DomainEnd
1405   integer ,dimension(*)         ,intent(in)      :: MemoryStart, MemoryEnd
1406   integer ,dimension(*)         ,intent(in)      :: PatchStart,  PatchEnd
1407   integer                       ,intent(out)     :: Status
1408
1409   type(wrf_phdf5_data_handle)    ,pointer        :: DH
1410   integer(hid_t)                                 :: GroupID
1411   integer                                        :: NDim
1412   character (VarNameLen)                         :: VarName
1413   character (3)                                  :: MemO
1414   character (3)                                  :: UCMemO
1415   integer(hid_t)                                 :: DsetID
1416   integer      ,dimension(NVarDims)              :: Length
1417   integer      ,dimension(NVarDims)              :: DomLength
1418   integer      ,dimension(NVarDims+1)            :: DimRank
1419   character(256),dimension(NVarDims)              :: RODimNames
1420   integer      ,dimension(NVarDims)              :: StoredStart
1421   integer      ,dimension(:,:,:,:),allocatable   :: XField
1422   integer      ,dimension(:,:,:,:),allocatable   :: BUFFER! for logical field
1423   integer                                        :: stat
1424   integer                                        :: NVar
1425   integer                                        :: i,j,k,m,dim_flag
1426   integer                                        :: i1,i2,j1,j2,k1,k2
1427   integer                                        :: x1,x2,y1,y2,z1,z2
1428   integer                                        :: l1,l2,m1,m2,n1,n2
1429   integer(hid_t)                                 :: XType
1430   integer                                        :: di
1431   character (256)                                 :: NullName
1432   integer                                        :: TimeIndex
1433   integer ,dimension(NVarDims+1)                 :: temprank
1434   logical                                        :: NotFound
1435
1436
1437   NullName = char(0)
1438   dim_flag = 0
1439
1440   call GetDH(DataHandle,DH,Status)
1441   if(Status /= WRF_NO_ERR) then
1442      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
1443      call wrf_debug ( WARN , msg)
1444      return
1445   endif
1446
1447   ! Examine here, Nov. 7th, 2003
1448   if(DH%FileStatus == WRF_FILE_OPENED_AND_COMMITTED) then
1449
1450      ! obtain group id and initialize the rank of dimensional attributes
1451      GroupID = DH%GroupID
1452      DimRank = -1
1453
1454      ! get the rank of the dimension based on MemoryOrder string(cleaver from NetCDF)
1455      call GetDim(MemoryOrder,NDim,Status)
1456      if(Status /= WRF_NO_ERR) then
1457         write(msg,*) 'Warning BAD MEMORY ORDER in ',__FILE__,', line', __LINE__
1458         call wrf_debug ( WARN , msg)
1459         return
1460      endif
1461
1462      ! check whether the DateStr is the correct length
1463      call DateCheck(DateStr,Status)
1464      if(Status /= WRF_NO_ERR) then
1465         write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__
1466         call wrf_debug ( WARN , msg)
1467         return
1468      endif
1469
1470      ! get the dataset name and dimensional information of the data
1471      VarName           = Var
1472      Length(1:NDim)    = PatchEnd(1:NDim) - PatchStart(1:NDim) + 1
1473      DomLength(1:NDim) = DomainEnd(1:NDim) - DomainStart(1:NDim) + 1
1474
1475      ! Transposing the data order and dim. string order, store to RODimNames
1476      call ExtOrder(MemoryOrder,Length,Status)
1477      call ExtOrder(MemoryOrder,DomLength,Status)
1478      if(Status /= WRF_NO_ERR) then
1479         write(msg,*) 'Warning BAD MEMORY ORDER in ',__FILE__,', line', __LINE__
1480         call wrf_debug ( WARN , msg)
1481         return
1482      endif
1483
1484      ! Map datatype from WRF to HDF5
1485      select case (FieldType)
1486      case (WRF_REAL)
1487         XType = H5T_NATIVE_REAL
1488      case (WRF_DOUBLE)
1489         Xtype = H5T_NATIVE_DOUBLE
1490      case (WRF_INTEGER)
1491         XType = H5T_NATIVE_INTEGER
1492      case (WRF_LOGICAL)
1493         XType = DH%EnumID
1494      case default
1495         Status = WRF_HDF5_ERR_DATA_TYPE_NOTFOUND
1496         return
1497      end select
1498
1499      ! HANDLE  with dim. scale
1500      ! handle dimensional scale data; search and store them in a table.
1501      ! The table is one dimensional array of compound data type. One member of
1502      ! the type is HDF5 string, representing the name of the dim(west_east_stag eg.)
1503      ! Another number is the length of the dimension(west_east_stag = 31)
1504      ! In this part, we will not store TIME but leave it at the end since the time
1505      ! index won't be known until the end of the run; since all fields(HDF5 datasets)
1506      ! have the same timestamp, writing it once should be fine.
1507
1508      ! 1) create a loop for dimensions
1509      call GetDataTimeIndex('write',DataHandle,DateStr,TimeIndex,Status)
1510      if(Status /= WRF_NO_ERR) then
1511         return
1512      endif
1513
1514      if(TimeIndex == 1) then
1515
1516         ! 2) get the dim. name, the first dim. is reserved for time,
1517         call ExtOrderStr(MemoryOrder,DimNames,RODimNames,Status)
1518         if(Status /= WRF_NO_ERR) then
1519            write(msg,*) 'Warning BAD MEMORY ORDER in ',__FILE__,', line', __LINE__
1520            call wrf_debug ( WARN , msg)
1521            return
1522         endif
1523         ! 3) get the dim. length
1524         ! 4) inside the loop, search the table for dimensional name( table module)
1525         !    IF FOUND, go to the next dimension, return the table dimensional rank
1526         !    (For example, find west_east_stag in the table, the rank of "west_east_stag"
1527         !     is 3; so return 3 for the array dimrank.)
1528         !    in the table; so through the table, we can find the information
1529         !    such as names, length of this dimension
1530         ! 4.1) save the rank into an array for attribute
1531         !      if not found,  go to 5)
1532         ! 4)' the first dimension is reserved for time, so table starts from j = 2
1533         !
1534         ! 5) NOT FOUND, inside the loop add the new dimensional information to the
1535         ! table(table module)
1536
1537         ! The first dimension of the field is always "time" and "time"
1538         ! is also the first dimension of the "table".
1539         k = 2
1540         DimRank(1) = 1
1541
1542         do i = 1,NDim
1543            do j = 2,MaxTabDims
1544
1545               ! Search for the table and see if we are at the end of the table
1546               if (DH%DIMTABLE(j)%dim_name == NO_NAME) then
1547
1548                  ! Sometimes the RODimNames is NULLName or ''. If that happens,
1549                  ! we will search the table from the beginning and see
1550                  ! whether the name is FAKEDIM(the default name) and  the
1551                  ! current length of the dim. is the same as that of FAKEDIM;
1552                  ! if yes, use this FAKEDIM for the current field dim.
1553
1554                  if(RODimNames(i) ==''.or. RODimNames(i)==NullName) then
1555                     do m = 2,j
1556                        if(DomLength(i)==DH%DIMTABLE(m)%Length.and. &
1557                             DH%DIMTABLE(m)%dim_name(1:7)=='FAKEDIM')then
1558                           DimRank(k) = m
1559                           k = k + 1
1560                           dim_flag = 1
1561                           exit
1562                        endif
1563                     enddo
1564                     ! No FAKEDIM and the same length dim. is found,
1565                     ! Add another dimension "FAKEDIM + j", with the length
1566                     ! as DomLength(i)
1567                     if (dim_flag == 1) then
1568                        dim_flag = 0
1569                     else
1570                        RODimNames(i) = 'FAKEDIM'//achar(j+iachar('0'))
1571                        DH%DIMTABLE(j)%dim_name  = RODimNames(i)
1572                        DH%DIMTABLE(j)%length    = DomLength(i)
1573                        DimRank(k) = j
1574                        k          = k + 1
1575                     endif
1576                     ! no '' or NULLName is found, then assign this RODimNames
1577                     ! to the dim. table.
1578                  else
1579                     DH%DIMTABLE(j)%dim_name  = RODimNames(i)
1580                     DH%DIMTABLE(j)%length    = DomLength(i)
1581                     DimRank(k)               = j
1582                     k = k + 1
1583                  endif
1584                  exit
1585                  ! If we found the current dim. in the table already,save the rank
1586               else if(DH%DIMTABLE(j)%dim_name == RODimNames(i)) then
1587                  ! remember the rank of dimensional scale
1588                  DimRank(k) = j
1589                  k = k + 1
1590                  exit
1591               else
1592                  continue
1593               endif
1594            enddo
1595         enddo
1596      endif ! end of timeindex of 1
1597
1598      ! 6) create an attribute array called DimRank to store the rank of the attribute.
1599      !    This will be done in the HDF5IOWRITE routine
1600
1601      ! 7) before the end of the run, 1) update time, 2) write the table to HDF5.
1602
1603      ! get the index of l1,.......for writing HDF5 file.
1604      StoredStart = 1
1605      call GetIndices(NDim,MemoryStart,MemoryEnd,l1,l2,m1,m2,n1,n2)
1606      call GetIndices(NDim,StoredStart,Length   ,x1,x2,y1,y2,z1,z2)
1607      call GetIndices(NDim,PatchStart, PatchEnd ,i1,i2,j1,j2,k1,k2)
1608      di=1
1609      if(FieldType == WRF_DOUBLE) di = 2
1610      allocate(XField(di,x1:x2,y1:y2,z1:z2), STAT=stat)
1611      if(stat/= 0) then
1612         Status = WRF_ERR_FATAL_ALLOCATION_ERROR
1613         write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line',__LINE__
1614         call wrf_debug ( FATAL , msg)
1615         return
1616      endif
1617
1618      ! Transpose the real data for tools people
1619      call Transpose_hdf5('write',MemoryOrder,di, Field,l1,l2,m1,m2,n1,n2 &
1620           ,XField,x1,x2,y1,y2,z1,z2 &
1621           ,i1,i2,j1,j2,k1,k2 )
1622
1623      ! handle with logical data separately,because of not able to
1624      ! map Fortran Logical type to C type
1625      if(FieldType .eq. WRF_LOGICAL) then
1626         allocate(BUFFER(di,x1:x2,y1:y2,z1:z2), STAT=stat)
1627         do k =z1,z2
1628            do j = y1,y2
1629               do i = x1,x2
1630                  do m = 1,di
1631                     if(XField(m,i,j,k)/= 0) then
1632                        BUFFER(m,i,j,k) = 1
1633                     else
1634                        BUFFER(m,i,j,k) = 0
1635                     endif
1636                  enddo
1637               enddo
1638            enddo
1639         enddo
1640         call HDF5IOWRITE(DataHandle,Comm,DateStr,Length,DomainStart, DomainEnd &
1641              ,PatchStart,PatchEnd, MemoryOrder &
1642              ,FieldType,XType,groupID,TimeIndex,DimRank &
1643              ,Var,BUFFER,Status)
1644         deallocate(BUFFER,STAT=stat)
1645         if(stat/=0) then
1646            Status = WRF_ERR_FATAL_ALLOCATION_ERROR
1647            write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line',__LINE__
1648            call wrf_debug ( FATAL , msg)
1649            return
1650         endif
1651      else
1652         call HDF5IOWRITE(DataHandle,Comm,DateStr,Length, DomainStart, DomainEnd &
1653              ,PatchStart, PatchEnd, MemoryOrder &
1654              ,FieldType,XType,groupID,TimeIndex,DimRank &
1655              ,Var,XField,Status)
1656      endif
1657
1658      if (Status /= WRF_NO_ERR) then
1659         return
1660      endif
1661
1662      deallocate(XField,STAT=stat)
1663      if(stat/=0) then
1664         Status = WRF_ERR_FATAL_ALLOCATION_ERROR
1665         write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line',__LINE__
1666         call wrf_debug ( FATAL , msg)
1667         return
1668      endif
1669   endif
1670
1671   DH%first_operation  = .FALSE.
1672
1673   return
1674
1675 end subroutine ext_phdf5_write_field
1676
1677 ! set_time routine is only used for open_for_read
1678 subroutine ext_phdf5_set_time(DataHandle, DateStr, Status)
1679
1680   use wrf_phdf5_data
1681   use ext_phdf5_support_routines
1682   use HDF5
1683   implicit none
1684   include 'wrf_status_codes.h'
1685
1686   integer               ,intent(in)          :: DataHandle
1687   character*(*)         ,intent(in)          :: DateStr
1688   integer               ,intent(out)         :: Status
1689   type(wrf_phdf5_data_handle) ,pointer        :: DH
1690   integer                                    :: i
1691
1692   ! check whether the Date length is equal to DateStrLen defined at wrf_phdf5_data
1693   ! sees not enough, leave it for the time being 3/12/2003
1694   call DateCheck(DateStr,Status)
1695   if(Status /= WRF_NO_ERR) then
1696      write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__
1697      call wrf_debug ( WARN , msg)
1698      return
1699   endif
1700
1701   call GetDH(DataHandle,DH,Status)
1702   if(Status /= WRF_NO_ERR) then
1703      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
1704      call wrf_debug ( WARN , msg)
1705      return
1706   endif
1707   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
1708      Status = WRF_HDF5_ERR_FILE_NOT_OPENED
1709      write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
1710      call wrf_debug ( WARN , msg)
1711   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
1712      Status = WRF_HDF5_ERR_FILE_NOT_COMMITTED
1713      write(msg,*) 'Warning FILE NOT COMMITTED in ',__FILE__,', line', __LINE__
1714      call wrf_debug ( WARN , msg)
1715   elseif(DH%FileStatus == WRF_FILE_OPENED_AND_COMMITTED) then
1716      Status = WRF_HDF5_ERR_READ_WONLY_FILE
1717      write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__
1718      call wrf_debug ( WARN , msg)
1719   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
1720      do i=1,MaxTimes
1721         if(DH%Times(i)==DateStr) then
1722            DH%CurrentTime = i
1723            exit
1724         endif
1725         if(i==MaxTimes) then
1726            Status = WRF_HDF5_ERR_TIME
1727            return
1728         endif
1729      enddo
1730      DH%CurrentVariable = 0
1731      Status = WRF_NO_ERR
1732   else
1733      Status = WRF_HDF5_ERR_BAD_FILE_STATUS
1734      write(msg,*) 'FATAL BAD FILE STATUS in ',__FILE__,', line', __LINE__
1735      call wrf_debug ( FATAL , msg)
1736   endif
1737   return
1738 end subroutine ext_phdf5_set_time
1739
1740 ! get_next_time routine is only used for open_for_read
1741 subroutine ext_phdf5_get_next_time(DataHandle, DateStr, Status)
1742   use wrf_phdf5_data
1743   use ext_phdf5_support_routines
1744   use HDF5
1745   implicit none
1746   include 'wrf_status_codes.h'
1747
1748   integer               ,intent(in)          :: DataHandle
1749   character*(*)         ,intent(out)         :: DateStr
1750   integer               ,intent(out)         :: Status
1751   type(wrf_phdf5_data_handle) ,pointer        :: DH
1752
1753   call GetDH(DataHandle,DH,Status)
1754   if(Status /= WRF_NO_ERR) then
1755      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
1756      call wrf_debug ( WARN , msg)
1757      return
1758   endif
1759
1760   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
1761      Status = WRF_HDF5_ERR_FILE_NOT_OPENED
1762      write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
1763      call wrf_debug ( WARN , msg)
1764   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
1765      Status = WRF_HDF5_ERR_DRYRUN_READ
1766      write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__
1767      call wrf_debug ( WARN , msg)
1768   elseif(DH%FileStatus == WRF_FILE_OPENED_AND_COMMITTED) then
1769      Status = WRF_HDF5_ERR_READ_WONLY_FILE
1770      write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__
1771      call wrf_debug ( WARN , msg)
1772   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
1773      if(DH%CurrentTime >= DH%NumberTimes) then
1774         Status = WRF_HDF5_ERR_TIME
1775         write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__
1776         call wrf_debug ( WARN , msg)
1777         return
1778      endif
1779      DH%CurrentTime     = DH%CurrentTime +1
1780      DateStr            = DH%Times(DH%CurrentTime)
1781      DH%CurrentVariable = 0
1782      Status = WRF_NO_ERR
1783   else
1784      Status = WRF_HDF5_ERR_BAD_FILE_STATUS
1785      write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
1786      call wrf_debug ( FATAL , msg)
1787   endif
1788   return
1789 end subroutine ext_phdf5_get_next_time
1790
1791 ! get_previous_time routine
1792 subroutine ext_phdf5_get_previous_time(DataHandle, DateStr, Status)
1793   use wrf_phdf5_data
1794   use ext_phdf5_support_routines
1795   use HDF5
1796   implicit none
1797   include 'wrf_status_codes.h'
1798
1799   integer               ,intent(in)          :: DataHandle
1800   character*(*)         ,intent(out)         :: DateStr
1801   integer               ,intent(out)         :: Status
1802   type(wrf_phdf5_data_handle) ,pointer        :: DH
1803
1804   call GetDH(DataHandle,DH,Status)
1805   if(Status /= WRF_NO_ERR) then
1806      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
1807      call wrf_debug ( WARN , msg)
1808      return
1809   endif
1810
1811   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
1812      Status = WRF_HDF5_ERR_FILE_NOT_OPENED
1813      write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
1814      call wrf_debug ( WARN , msg)
1815   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
1816      Status = WRF_HDF5_ERR_DRYRUN_READ
1817      write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__
1818      call wrf_debug ( WARN , msg)
1819   elseif(DH%FileStatus == WRF_FILE_OPENED_AND_COMMITTED) then
1820      Status = WRF_HDF5_ERR_READ_WONLY_FILE
1821      write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__
1822      call wrf_debug ( WARN , msg)
1823   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
1824      if(DH%CurrentTime.GT.0) then
1825        DH%CurrentTime = DH%CurrentTime - 1
1826      endif
1827      DateStr            = DH%Times(DH%CurrentTime)
1828      DH%CurrentVariable = 0
1829      Status = WRF_NO_ERR
1830   else
1831      Status = WRF_HDF5_ERR_BAD_FILE_STATUS
1832      write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
1833      call wrf_debug ( FATAL , msg)
1834   endif
1835   return
1836 end subroutine ext_phdf5_get_previous_time
1837
1838 subroutine ext_phdf5_get_var_info(DataHandle,Name,NDim,MemoryOrder,Stagger,DomainStart,DomainEnd,WrfType,Status)
1839
1840   use wrf_phdf5_data
1841   use ext_phdf5_support_routines
1842   use HDF5
1843   implicit none
1844   include 'wrf_status_codes.h'
1845   integer               ,intent(in)     :: DataHandle
1846   character*(*)         ,intent(in)     :: Name
1847   integer               ,intent(out)    :: NDim
1848   character*(*)         ,intent(out)    :: MemoryOrder
1849   character*(*)         ,intent(out)    :: Stagger ! Dummy for now
1850   integer ,dimension(*) ,intent(out)    :: DomainStart, DomainEnd
1851   integer               ,intent(out)    :: WrfType
1852   integer               ,intent(out)    :: Status
1853   type(wrf_phdf5_data_handle) ,pointer   :: DH
1854   integer                               :: VarID
1855   integer ,dimension(NVarDims)          :: VDimIDs
1856   integer                               :: j
1857   integer                               :: hdf5err
1858   integer                               :: XType
1859
1860   character(Len =MaxTimeSLen)           :: tname
1861   character(Len = 512)                  :: tgroupname
1862   integer(hid_t)                        :: tgroupid
1863   integer(hid_t)                        :: dsetid
1864   integer(hid_t)                        :: dspaceid
1865   integer                               :: HDF5_NDim
1866   integer(hsize_t),dimension(:),allocatable         :: h5dims
1867   integer(hsize_t),dimension(:),allocatable         :: h5maxdims
1868
1869   call GetDH(DataHandle,DH,Status)
1870   if(Status /= WRF_NO_ERR) then
1871      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
1872      call wrf_debug ( WARN , TRIM(msg))
1873      return
1874   endif
1875   if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
1876      Status = WRF_HDF5_ERR_FILE_NOT_OPENED
1877      write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
1878      call wrf_debug ( WARN , TRIM(msg))
1879      return
1880   elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
1881      Status = WRF_HDF5_ERR_DRYRUN_READ
1882      write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__
1883      call wrf_debug ( WARN , TRIM(msg))
1884      return
1885   elseif(DH%FileStatus == WRF_FILE_OPENED_AND_COMMITTED) then
1886      Status = WRF_HDF5_ERR_READ_WONLY_FILE
1887      write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__
1888      call wrf_debug ( WARN , TRIM(msg))
1889      return
1890   elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
1891      if(Name /= "Times") then
1892         call numtochar(1,tname)
1893         tgroupname = 'TIME_STAMP_'//tname
1894         call h5gopen_f(DH%GroupID,tgroupname,tgroupid,hdf5err)
1895         if(hdf5err.lt.0) then
1896            Status = WRF_HDF5_ERR_GROUP
1897            write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
1898            call wrf_debug ( WARN , msg)
1899            return
1900         endif
1901         call h5dopen_f(tgroupid,Name,dsetid,hdf5err)
1902         if(hdf5err /= 0) then
1903            STATUS = WRF_HDF5_ERR_DATASET_OPEN
1904            write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
1905            call wrf_debug ( WARN , msg)
1906            return
1907         endif
1908         call h5dget_space_f(dsetid,dspaceid,hdf5err)
1909         if(hdf5err.lt.0) then
1910            Status = WRF_HDF5_ERR_DATASPACE
1911            write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
1912            call wrf_debug ( WARN , msg)
1913            return
1914         endif
1915
1916         call h5sget_simple_extent_ndims_f(dspaceid,HDF5_NDim,hdf5err)
1917         if(hdf5err.lt.0) then
1918            Status = WRF_HDF5_ERR_DATASPACE
1919            write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
1920            call wrf_debug ( WARN , msg)
1921            return
1922         endif
1923
1924         call ext_phdf5_get_var_ti_char(DataHandle,"MemoryOrder",Name,MemoryOrder,Status)
1925         if(Status /= WRF_NO_ERR) then
1926            Status = WRF_HDF5_ERR_ATTRIBUTE_GENERAL
1927            write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
1928            call wrf_debug ( WARN , msg)
1929            return
1930         endif
1931
1932         ! get the rank of the dimension
1933         call GetDim(MemoryOrder,NDim,Status)
1934         if(Status /= WRF_NO_ERR) then
1935            write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
1936            call wrf_debug ( WARN , msg)
1937            return
1938         endif
1939         if((NDim+1)/= HDF5_NDim)then
1940            Status = WRF_HDF5_ERR_DATASPACE
1941            write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
1942            call wrf_debug ( WARN , msg)
1943            return
1944         endif
1945         call ext_phdf5_get_var_ti_char(DataHandle,"Stagger",Name,Stagger,Status)
1946         if(Status /= WRF_NO_ERR) then
1947            Status = WRF_HDF5_ERR_ATTRIBUTE_GENERAL
1948            write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
1949            call wrf_debug ( WARN , msg)
1950            return
1951         endif
1952         call ext_phdf5_get_var_ti_integer(DataHandle,"FieldType",Name,WrfType,Status)
1953         if(Status /= WRF_NO_ERR) then
1954            Status = WRF_HDF5_ERR_ATTRIBUTE_GENERAL
1955            write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
1956            call wrf_debug ( WARN , msg)
1957            return
1958         endif
1959
1960         ! obtain Domain Start and Domain End.
1961         allocate(h5dims(NDim+1))
1962         allocate(h5maxdims(NDim+1))
1963         call h5sget_simple_extent_dims_f(dspaceid,h5dims,h5maxdims,hdf5err)
1964         if(hdf5err .lt. 0) then
1965            Status = WRF_HDF5_ERR_DATASPACE
1966            write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
1967            call wrf_debug ( WARN , msg)
1968            return
1969         endif
1970
1971         do j =1, NDim
1972            DomainStart(j) = 1
1973            DomainEnd(j) = h5dims(j)
1974         enddo
1975         deallocate(h5dims)
1976         deallocate(h5maxdims)
1977      endif
1978      return
1979   endif
1980   return
1981 end subroutine ext_phdf5_get_var_info
1982
1983 ! obtain the domain time independent attribute with REAL type
1984 subroutine ext_phdf5_get_dom_ti_real(DataHandle,Element,Data,Count,OutCount,Status)
1985
1986   use wrf_phdf5_data
1987   use ext_phdf5_support_routines
1988   USE HDF5 ! This module contains all necessary modules
1989   use get_attrid_routine
1990   implicit none
1991   include 'wrf_status_codes.h'
1992
1993   integer               ,intent(in)     :: DataHandle
1994   character*(*)         ,intent(in)     :: Element
1995   real                  ,intent(out)    :: Data(*)
1996   real    ,dimension(:),allocatable     :: buffer
1997   integer               ,intent(in)     :: Count
1998   integer               ,intent(out)    :: OutCount
1999   integer               ,intent(out)    :: Status
2000   integer(hid_t)                        :: h5_atypeid
2001   integer(hid_t)                        :: h5_aspaceid
2002   integer(hid_t)                        :: h5_attrid
2003   integer                               :: rank
2004   integer(hid_t)                        :: attr_type
2005   integer(hsize_t), dimension(7)        :: h5_dims
2006   integer                               :: hdf5err
2007
2008   ! Do nothing unless it is time to read time-independent domain metadata.
2009   IF ( .NOT. phdf5_ok_to_get_dom_ti( DataHandle ) ) THEN
2010     Status = WRF_NO_ERR
2011     return
2012   ENDIF
2013
2014   attr_type = H5T_NATIVE_REAL
2015
2016   call get_attrid(DataHandle,Element,h5_attrid,Status)
2017   if(Status /= WRF_NO_ERR) then
2018      return
2019   endif
2020
2021   call check_type(DataHandle,attr_type,h5_attrid,Status)
2022   if (Status /= WRF_NO_ERR) then
2023      return
2024   endif
2025
2026   call retrieve_ti_info(DataHandle,h5_attrid,h5_atypeid,&
2027        Count,OutCount,Status)
2028   if (Status /= WRF_NO_ERR) then
2029      return
2030   endif
2031
2032   allocate(buffer(OutCount))
2033
2034   h5_dims(1) = OutCount
2035   call h5aread_f(h5_attrid,attr_type,buffer,h5_dims,hdf5err)
2036   if(hdf5err.lt.0) then
2037      Status =  WRF_HDF5_ERR_ATTRIBUTE_READ
2038      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
2039      call wrf_debug ( WARN , msg)
2040      deallocate(buffer)
2041      return
2042   endif
2043
2044   data(1:OutCount) = buffer(1:OutCount)
2045
2046   deallocate(buffer)
2047
2048   return
2049
2050 end subroutine ext_phdf5_get_dom_ti_real
2051
2052 ! obtain the domain time independent attribute with REAL8 type
2053 subroutine ext_phdf5_get_dom_ti_double(DataHandle,Element,Data,Count,OutCount,Status)
2054
2055   use wrf_phdf5_data
2056   use ext_phdf5_support_routines
2057   USE HDF5 ! This module contains all necessary modules
2058   use get_attrid_routine
2059   implicit none
2060   include 'wrf_status_codes.h'
2061
2062   integer               ,intent(in)     :: DataHandle
2063   character*(*)         ,intent(in)     :: Element
2064   real*8                ,intent(out)    :: Data(*)
2065   integer               ,intent(in)     :: Count
2066   integer               ,intent(out)    :: OutCount
2067   integer               ,intent(out)    :: Status
2068   integer(hid_t)                        :: h5_atypeid
2069   integer(hid_t)                        :: h5_aspaceid
2070   integer(hid_t)                        :: h5_attrid
2071   integer                               :: rank
2072   integer                               :: hdf5err
2073   integer(hid_t)                        :: attr_type
2074   integer(hsize_t), dimension(7)        :: h5_dims
2075
2076   ! Do nothing unless it is time to read time-independent domain metadata.
2077   IF ( .NOT. phdf5_ok_to_get_dom_ti( DataHandle ) ) THEN
2078     Status = WRF_NO_ERR
2079     return
2080   ENDIF
2081
2082   attr_type = H5T_NATIVE_DOUBLE
2083   call get_attrid(DataHandle,Element,h5_attrid,Status)
2084   if(Status /= WRF_NO_ERR) then
2085      return
2086   endif
2087
2088   call check_type(DataHandle,attr_type,h5_attrid,Status)
2089   if (Status /= WRF_NO_ERR) then
2090      return
2091   endif
2092
2093   call  retrieve_ti_info(DataHandle,h5_attrid,h5_atypeid,&
2094        Count,OutCount,Status)
2095   if (Status /= WRF_NO_ERR) then
2096      return
2097   endif
2098
2099   h5_dims(1) = OutCount
2100   call h5aread_f(h5_attrid,attr_type,data,h5_dims,hdf5err)
2101   if(hdf5err.lt.0) then
2102      Status =  WRF_HDF5_ERR_ATTRIBUTE_READ
2103      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
2104      call wrf_debug ( WARN , msg)
2105      return
2106   endif
2107
2108   return
2109 end subroutine ext_phdf5_get_dom_ti_double
2110
2111
2112 ! obtain the domain time independent attribute with integer type
2113 subroutine ext_phdf5_get_dom_ti_integer(DataHandle,Element,Data,Count,OutCount,Status)
2114
2115   use wrf_phdf5_data
2116   use ext_phdf5_support_routines
2117   USE HDF5 ! This module contains all necessary modules
2118   use get_attrid_routine
2119   implicit none
2120   include 'wrf_status_codes.h'
2121
2122   integer               ,intent(in)     :: DataHandle
2123   character*(*)         ,intent(in)     :: Element
2124   integer               ,intent(out)    :: Data(*)
2125   integer               ,intent(in)     :: Count
2126   integer               ,intent(out)    :: OutCount
2127   integer               ,intent(out)    :: Status
2128   integer(hid_t)                        :: h5_atypeid
2129   integer(hid_t)                        :: h5_aspaceid
2130   integer(hid_t)                        :: h5_attrid
2131   integer                               :: rank
2132   integer(hid_t)                        :: attr_type
2133   integer(hsize_t), dimension(7)        :: h5_dims
2134   integer                               :: hdf5err
2135
2136   ! Do nothing unless it is time to read time-independent domain metadata.
2137   IF ( .NOT. phdf5_ok_to_get_dom_ti( DataHandle ) ) THEN
2138     Status = WRF_NO_ERR
2139     return
2140   ENDIF
2141
2142   attr_type = H5T_NATIVE_INTEGER
2143
2144   call get_attrid(DataHandle,Element,h5_attrid,Status)
2145   if(Status /= WRF_NO_ERR) then
2146      return
2147   endif
2148
2149   call check_type(DataHandle,attr_type,h5_attrid,Status)
2150   if (Status /= WRF_NO_ERR) then
2151      return
2152   endif
2153
2154   call  retrieve_ti_info(DataHandle,h5_attrid,h5_atypeid,&
2155        Count,OutCount,Status)
2156   if (Status /= WRF_NO_ERR) then
2157      return
2158   endif
2159
2160   h5_dims(1) = OutCount
2161   call h5aread_f(h5_attrid,attr_type,Data,h5_dims,Status)
2162   if(hdf5err.lt.0) then
2163      Status =  WRF_HDF5_ERR_ATTRIBUTE_READ
2164      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
2165      call wrf_debug ( WARN , msg)
2166      return
2167   endif
2168
2169   return
2170 end subroutine ext_phdf5_get_dom_ti_integer
2171
2172
2173 subroutine ext_phdf5_get_dom_ti_logical(DataHandle,Element,Data,Count,OutCount,Status)
2174
2175   use wrf_phdf5_data
2176   use ext_phdf5_support_routines
2177   USE HDF5 ! This module contains all necessary modules
2178   use get_attrid_routine
2179   implicit none
2180   include 'wrf_status_codes.h'
2181
2182   integer               ,intent(in)           :: DataHandle
2183   character*(*)         ,intent(in)           :: Element
2184   logical               ,intent(out)          :: Data(*)
2185   integer,       dimension(:),allocatable     :: buffer
2186   integer               ,intent(in)           :: Count
2187   integer               ,intent(out)          :: OutCount
2188   integer               ,intent(out)          :: Status
2189   integer(hid_t)                              :: h5_atypeid
2190   integer(hid_t)                              :: h5_aspaceid
2191   integer(hid_t)                              :: h5_attrid
2192   integer                                     :: rank
2193   integer(hid_t)                              :: attr_type
2194   type(wrf_phdf5_data_handle),pointer          :: DH
2195   integer(hsize_t), dimension(7)              :: h5_dims
2196   integer                                     :: hdf5err
2197
2198
2199   call GetDH(DataHandle,DH,Status)
2200   if(Status /= WRF_NO_ERR) then
2201      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
2202      call wrf_debug ( WARN , msg)
2203      return
2204   endif
2205
2206   ! Do nothing unless it is time to read time-independent domain metadata.
2207   IF ( .NOT. phdf5_ok_to_get_dom_ti( DataHandle ) ) THEN
2208     Status = WRF_NO_ERR
2209     return
2210   ENDIF
2211
2212   attr_type = DH%EnumID
2213   call get_attrid(DataHandle,Element,h5_attrid,Status)
2214   if(Status /= WRF_NO_ERR) then
2215      return
2216   endif
2217
2218   call check_type(DataHandle,attr_type,h5_attrid,Status)
2219   if (status /= WRF_NO_ERR) then
2220      return
2221   endif
2222
2223   call  retrieve_ti_info(DataHandle,h5_attrid,h5_atypeid,&
2224        Count,OutCount,Status)
2225   if (Status /= WRF_NO_ERR) then
2226      return
2227   endif
2228
2229   h5_dims(1) = OutCount
2230
2231   allocate(buffer(OutCount))
2232
2233   call h5aread_f(h5_attrid,attr_type,buffer,h5_dims,hdf5err)
2234   if(hdf5err.lt.0) then
2235      Status =  WRF_HDF5_ERR_ATTRIBUTE_READ
2236      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
2237      call wrf_debug ( WARN , msg)
2238      deallocate(buffer)
2239      return
2240   endif
2241
2242   Data(1:OutCount) = buffer(1:OutCount)==1
2243   deallocate(buffer)
2244   return
2245 end subroutine ext_phdf5_get_dom_ti_logical
2246
2247 ! obtain the domain time independent attribute with char type
2248 subroutine ext_phdf5_get_dom_ti_char(DataHandle,Element,Data,Status)
2249
2250   use wrf_phdf5_data
2251   use ext_phdf5_support_routines
2252   USE HDF5 ! This module contains all necessary modules
2253   use get_attrid_routine
2254   implicit none
2255   include 'wrf_status_codes.h'
2256
2257   integer               ,intent(in)     :: DataHandle
2258   character*(*)         ,intent(in)     :: Element
2259   character*(*)         ,intent(out)    :: Data
2260   integer                               :: Count
2261   integer                               :: OutCount
2262   integer               ,intent(out)    :: Status
2263   integer(hid_t)                        :: h5_atypeid
2264   integer(hid_t)                        :: h5_aspaceid
2265   integer(hid_t)                        :: h5_attrid
2266   integer                               :: rank
2267   integer(hid_t)                        :: attr_type
2268   integer(hsize_t), dimension(7)        :: h5_dims
2269   integer                               :: hdf5err
2270
2271   ! Do nothing unless it is time to read time-independent domain metadata.
2272   IF ( .NOT. phdf5_ok_to_get_dom_ti( DataHandle ) ) THEN
2273     Status = WRF_NO_ERR
2274     return
2275   ENDIF
2276
2277   attr_type = H5T_NATIVE_CHARACTER
2278
2279   call get_attrid(DataHandle,Element,h5_attrid,Status)
2280   if(Status /= WRF_NO_ERR) then
2281      return
2282   endif
2283
2284   call check_type(DataHandle,attr_type,h5_attrid,Status)
2285   if (status /= WRF_NO_ERR) then
2286      return
2287   endif
2288
2289   call  retrieve_ti_info(DataHandle,h5_attrid,h5_atypeid,&
2290        Count,OutCount,Status)
2291   if(Status /= WRF_NO_ERR) then
2292      return
2293   endif
2294
2295   h5_dims(1) = OutCount
2296   call h5aread_f(h5_attrid,h5_atypeid,data,h5_dims,hdf5err)
2297   if(hdf5err.lt.0) then
2298      Status =  WRF_HDF5_ERR_ATTRIBUTE_READ
2299      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
2300      call wrf_debug ( WARN , msg)
2301      return
2302   endif
2303
2304   return
2305 end subroutine ext_phdf5_get_dom_ti_char
2306
2307 subroutine ext_phdf5_put_dom_td_real(DataHandle,Element,DateStr,Data,Count,Status)
2308   integer               ,intent(in)     :: DataHandle
2309   character*(*)         ,intent(in)     :: Element
2310   character*(*)         ,intent(in)     :: DateStr
2311   real                  ,intent(in)     :: Data(*)
2312   integer               ,intent(in)     :: Count
2313   integer               ,intent(out)    :: Status
2314
2315   call ext_phdf5_put_var_td_real(DataHandle,Element,DateStr,&
2316        'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_',&
2317        Data,Count,Status)
2318   return
2319 end subroutine ext_phdf5_put_dom_td_real
2320
2321 subroutine ext_phdf5_put_dom_td_double(DataHandle,Element,DateStr,Data,Count,Status)
2322   integer               ,intent(in)     :: DataHandle
2323   character*(*)         ,intent(in)     :: Element
2324   character*(*)         ,intent(in)     :: DateStr
2325   real*8                ,intent(in)     :: Data(*)
2326   integer               ,intent(in)     :: Count
2327   integer               ,intent(out)    :: Status
2328
2329   call ext_phdf5_put_var_td_double(DataHandle,Element,DateStr,&
2330        'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_',&
2331        Data,Count,Status)
2332   return
2333 end subroutine ext_phdf5_put_dom_td_double
2334
2335 subroutine ext_phdf5_put_dom_td_logical(DataHandle,Element,DateStr,Data,Count,Status)
2336   integer               ,intent(in)     :: DataHandle
2337   character*(*)         ,intent(in)     :: Element
2338   character*(*)         ,intent(in)     :: DateStr
2339   logical               ,intent(in)     :: Data(*)
2340   integer               ,intent(in)     :: Count
2341   integer               ,intent(out)    :: Status
2342
2343   call ext_phdf5_put_var_td_logical(DataHandle,Element,DateStr,&
2344        'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_',&
2345        Data,Count,Status)
2346   return
2347
2348 end subroutine ext_phdf5_put_dom_td_logical
2349 subroutine ext_phdf5_put_dom_td_integer(DataHandle,Element,DateStr,Data,Count,Status)
2350   integer               ,intent(in)     :: DataHandle
2351   character*(*)         ,intent(in)     :: Element
2352   character*(*)         ,intent(in)     :: DateStr
2353   integer               ,intent(in)     :: Data(*)
2354   integer               ,intent(in)     :: Count
2355   integer               ,intent(out)    :: Status
2356
2357   call ext_phdf5_put_var_td_integer(DataHandle,Element,DateStr,&
2358        'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_',&
2359        Data,Count,Status)
2360   return
2361 end subroutine ext_phdf5_put_dom_td_integer
2362
2363 subroutine ext_phdf5_put_dom_td_char(DataHandle,Element,DateStr,Data,Status)
2364
2365   integer               ,intent(in)     :: DataHandle
2366   character*(*)         ,intent(in)     :: Element
2367   character*(*)         ,intent(in)     :: DateStr
2368   character*(*)         ,intent(in)     :: Data
2369   integer               ,intent(out)    :: Status
2370
2371   call ext_phdf5_put_var_td_char(DataHandle,Element,DateStr,&
2372        'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_',&
2373        Data,Status)
2374   return
2375
2376 end subroutine ext_phdf5_put_dom_td_char
2377
2378 subroutine ext_phdf5_get_dom_td_real(DataHandle,Element,DateStr,Data,Count,OutCount,Status)
2379
2380
2381   integer               ,intent(in)             :: DataHandle
2382   character*(*)         ,intent(in)             :: Element
2383   character*(*)         ,intent(in)             :: DateStr
2384   real                  ,intent(out)            :: Data(*)
2385   integer               ,intent(in)             :: Count
2386   integer               ,intent(out)            :: OutCount
2387   integer               ,intent(out)            :: Status
2388
2389   call ext_phdf5_get_var_td_real(DataHandle,Element,DateStr,&
2390        'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_',Data,Count,OutCount,Status)
2391   return
2392 end subroutine ext_phdf5_get_dom_td_real
2393
2394 subroutine ext_phdf5_get_dom_td_double(DataHandle,Element,DateStr,Data,Count,OutCount,Status)
2395
2396   integer               ,intent(in)             :: DataHandle
2397   character*(*)         ,intent(in)             :: Element
2398   character*(*)         ,intent(in)             :: DateStr
2399   real*8                ,intent(out)            :: Data(*)
2400   integer               ,intent(in)             :: Count
2401   integer               ,intent(out)            :: OutCount
2402   integer               ,intent(out)            :: Status
2403
2404   call ext_phdf5_get_var_td_double(DataHandle,Element,DateStr,&
2405        'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_',Data,Count,OutCount,Status)
2406   return
2407 end subroutine ext_phdf5_get_dom_td_double
2408
2409
2410 subroutine ext_phdf5_get_dom_td_integer(DataHandle,Element,DateStr,Data,Count,OutCount,Status)
2411
2412   integer               ,intent(in)             :: DataHandle
2413   character*(*)         ,intent(in)             :: Element
2414   character*(*)         ,intent(in)             :: DateStr
2415   integer               ,intent(out)            :: Data(*)
2416   integer               ,intent(in)             :: Count
2417   integer               ,intent(out)            :: OutCount
2418   integer               ,intent(out)            :: Status
2419
2420   call ext_phdf5_get_var_td_integer(DataHandle,Element,DateStr,&
2421        'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_',Data,Count,OutCount,Status)
2422   return
2423
2424 end subroutine ext_phdf5_get_dom_td_integer
2425
2426 subroutine ext_phdf5_get_dom_td_logical(DataHandle,Element,DateStr,Data,Count,OutCount,Status)
2427   integer               ,intent(in)             :: DataHandle
2428   character*(*)         ,intent(in)             :: Element
2429   character*(*)         ,intent(in)             :: DateStr
2430   logical               ,intent(out)            :: Data(*)
2431   integer               ,intent(in)             :: Count
2432   integer               ,intent(out)            :: OutCount
2433   integer               ,intent(out)            :: Status
2434
2435   call ext_phdf5_get_var_td_logical(DataHandle,Element,DateStr,&
2436        'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_',Data,Count,OutCount,Status)
2437   return
2438
2439 end subroutine ext_phdf5_get_dom_td_logical
2440
2441
2442 subroutine ext_phdf5_get_dom_td_char(DataHandle,Element,DateStr,Data,Status)
2443
2444   integer               ,intent(in)             :: DataHandle
2445   character*(*)         ,intent(in)             :: Element
2446   character*(*)         ,intent(in)             :: DateStr
2447   character*(*)         ,intent(out)            :: Data
2448   integer               ,intent(out)            :: Status
2449
2450
2451   call ext_phdf5_get_var_td_char(DataHandle,Element,DateStr,&
2452        'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_',Data,Status)
2453   return
2454
2455
2456 end subroutine ext_phdf5_get_dom_td_char
2457
2458 subroutine ext_phdf5_put_var_td_real(DataHandle,Element,DateStr,Var,Data,Count,Status)
2459
2460   use wrf_phdf5_data
2461   use ext_phdf5_support_routines
2462   USE HDF5 ! This module contains all necessary modules
2463   implicit none
2464   include 'wrf_status_codes.h'
2465
2466   integer               ,intent(in)             :: DataHandle
2467   character*(*)         ,intent(in)             :: Element
2468   character*(*)         ,intent(in)             :: DateStr
2469   character*(*)         ,intent(in)             :: Var
2470   character(len = 256)                           :: DataSetName
2471   real                  ,intent(in)             :: Data(*)
2472   integer               ,intent(in)             :: Count
2473   integer               ,intent(out)            :: Status
2474   type(wrf_phdf5_data_handle),pointer           :: DH
2475   integer                                       :: TimeIndex
2476   integer(hid_t)                                :: dset_id
2477   integer(hid_t)                                :: dspaceid
2478   integer(hid_t)                                :: fspaceid
2479   integer(hid_t)                                :: tgroupid
2480   integer(hsize_t),dimension(1)                 :: dims
2481   integer                                       :: hdf5err
2482   integer                                       :: i
2483
2484   call GetDH(DataHandle,DH,Status)
2485   if(Status /= WRF_NO_ERR) then
2486      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
2487      call wrf_debug ( WARN , msg)
2488      return
2489   endif
2490
2491   ! check whether the DateStr is the correct length
2492   call DateCheck(DateStr,Status)
2493   if(Status /= WRF_NO_ERR) then
2494      write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__
2495      call wrf_debug ( WARN , msg)
2496      return
2497   endif
2498
2499   if(DH%FileStatus == WRF_FILE_OPENED_AND_COMMITTED) then
2500
2501      dims(1) = Count
2502
2503      ! Get the time index
2504      call GetAttrTimeIndex('write',DataHandle,DateStr,TimeIndex,Status)
2505      if(Status /= WRF_NO_ERR) then
2506         return
2507      endif
2508
2509      ! Set up dataspace,property list
2510      call GetName(Element,Var,DataSetName,Status)
2511      if(Status /= WRF_NO_ERR) then
2512         return
2513      endif
2514
2515      call setup_wrtd_dataset(DataHandle,DataSetName,H5T_NATIVE_REAL,Count,&
2516           dset_id,dspaceid,fspaceid,tgroupid,TimeIndex,Status)
2517      if(Status /= WRF_NO_ERR) then
2518         return
2519      endif
2520
2521      call h5dwrite_f(dset_id,H5T_NATIVE_REAL,Data,dims,hdf5err,dspaceid,&
2522           fspaceid)
2523      if(hdf5err.lt.0) then
2524         Status =  WRF_HDF5_ERR_DATASET_WRITE
2525         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
2526         call wrf_debug ( WARN , msg)
2527         return
2528      endif
2529      call h5dclose_f(dset_id,hdf5err)
2530      call h5sclose_f(dspaceid,hdf5err)
2531      call h5sclose_f(fspaceid,hdf5err)
2532 !     call h5gclose_f(tgroupid,hdf5err)
2533   endif
2534   return
2535 end subroutine ext_phdf5_put_var_td_real
2536
2537 subroutine ext_phdf5_put_var_td_double(DataHandle,Element,DateStr,Var,Data,Count,Status)
2538   use wrf_phdf5_data
2539   use ext_phdf5_support_routines
2540   USE HDF5 ! This module contains all necessary modules
2541   implicit none
2542   include 'wrf_status_codes.h'
2543
2544   integer               ,intent(in)             :: DataHandle
2545   character*(*)         ,intent(in)             :: Element
2546   character*(*)         ,intent(in)             :: DateStr
2547   character*(*)         ,intent(in)             :: Var
2548   character(len = 256)                           :: DataSetName
2549   real*8                ,intent(in)             :: Data(*)
2550   integer               ,intent(in)             :: Count
2551   integer               ,intent(out)            :: Status
2552   type(wrf_phdf5_data_handle),pointer            :: DH
2553   integer                                       :: TimeIndex
2554   integer(hid_t)                                :: dset_id
2555   integer(hid_t)                                :: dspaceid
2556   integer(hid_t)                                :: fspaceid
2557   integer(hid_t)                                :: tgroupid
2558   integer(hsize_t),dimension(1)                 :: dims
2559   integer                                       :: hdf5err
2560   integer                                       :: i
2561
2562   call GetDH(DataHandle,DH,Status)
2563   if(Status /= WRF_NO_ERR) then
2564      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
2565      call wrf_debug ( WARN , msg)
2566      return
2567   endif
2568
2569   ! check whether the DateStr is the correct length
2570   call DateCheck(DateStr,Status)
2571   if(Status /= WRF_NO_ERR) then
2572      write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__
2573      call wrf_debug ( WARN , msg)
2574      return
2575   endif
2576
2577   if(DH%FileStatus == WRF_FILE_OPENED_AND_COMMITTED) then
2578
2579
2580      dims(1) = Count
2581      ! Get the time index
2582      call GetAttrTimeIndex('write',DataHandle,DateStr,TimeIndex,Status)
2583      if(Status /= WRF_NO_ERR) then
2584         return
2585      endif
2586
2587      ! Set up dataspace,property list
2588      call GetName(Element,Var,DataSetName,Status)
2589      call setup_wrtd_dataset(DataHandle,DataSetName,H5T_NATIVE_DOUBLE,Count,&
2590           dset_id,dspaceid,fspaceid,tgroupid,TimeIndex,Status)
2591
2592      if(Status /= WRF_NO_ERR) then
2593         return
2594      endif
2595
2596      call h5dwrite_f(dset_id,H5T_NATIVE_DOUBLE,Data,dims,hdf5err,dspaceid,&
2597           fspaceid)
2598      if(hdf5err.lt.0) then
2599         Status =  WRF_HDF5_ERR_DATASET_WRITE
2600         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
2601         call wrf_debug ( WARN , msg)
2602         return
2603      endif
2604
2605      call h5dclose_f(dset_id,hdf5err)
2606      call h5sclose_f(dspaceid,hdf5err)
2607      call h5sclose_f(fspaceid,hdf5err)
2608 !     call h5gclose_f(tgroupid,hdf5err)
2609
2610   endif
2611   return
2612 end subroutine ext_phdf5_put_var_td_double
2613
2614 subroutine ext_phdf5_put_var_td_integer(DataHandle,Element,DateStr,Var,Data,Count,Status)
2615
2616   use wrf_phdf5_data
2617   use ext_phdf5_support_routines
2618   USE HDF5 ! This module contains all necessary modules
2619   implicit none
2620   include 'wrf_status_codes.h'
2621
2622   integer               ,intent(in)             :: DataHandle
2623   character*(*)         ,intent(in)             :: Element
2624   character*(*)         ,intent(in)             :: DateStr
2625   character*(*)         ,intent(in)             :: Var
2626   character(len = 256)                           :: DataSetName
2627   integer               ,intent(in)             :: Data(*)
2628   integer               ,intent(in)             :: Count
2629   integer               ,intent(out)            :: Status
2630   type(wrf_phdf5_data_handle),pointer            :: DH
2631   integer                                       :: TimeIndex
2632   integer(hid_t)                                :: dset_id
2633   integer(hid_t)                                :: dspaceid
2634   integer(hid_t)                                :: fspaceid
2635   integer(hid_t)                                :: tgroupid
2636   integer(hsize_t),dimension(1)                 :: dims
2637   integer                                       :: hdf5err
2638   integer                                       :: i
2639
2640   call GetDH(DataHandle,DH,Status)
2641   if(Status /= WRF_NO_ERR) then
2642      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
2643      call wrf_debug ( WARN , msg)
2644      return
2645   endif
2646
2647   ! check whether the DateStr is the correct length
2648   call DateCheck(DateStr,Status)
2649   if(Status /= WRF_NO_ERR) then
2650      write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__
2651      call wrf_debug ( WARN , msg)
2652      return
2653   endif
2654
2655   if(DH%FileStatus == WRF_FILE_OPENED_AND_COMMITTED) then
2656
2657
2658      dims(1) = Count
2659      ! Get the time index
2660      call GetAttrTimeIndex('write',DataHandle,DateStr,TimeIndex,Status)
2661      if(Status /= WRF_NO_ERR) then
2662         return
2663      endif
2664
2665      ! Set up dataspace,property list
2666      call GetName(Element,Var,DataSetName,Status)
2667
2668      call setup_wrtd_dataset(DataHandle,DataSetName,H5T_NATIVE_INTEGER, &
2669           Count,dset_id,dspaceid,fspaceid,tgroupid,  &
2670           TimeIndex, Status)
2671      if(Status /= WRF_NO_ERR) then
2672         return
2673      endif
2674
2675      call h5dwrite_f(dset_id,H5T_NATIVE_INTEGER,Data,dims,hdf5err,dspaceid,&
2676           fspaceid)
2677      if(hdf5err.lt.0) then
2678         Status =  WRF_HDF5_ERR_DATASET_WRITE
2679         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
2680         call wrf_debug ( WARN , msg)
2681         return
2682      endif
2683
2684      call h5dclose_f(dset_id,hdf5err)
2685      call h5sclose_f(dspaceid,hdf5err)
2686      call h5sclose_f(fspaceid,hdf5err)
2687 !     call h5gclose_f(tgroupid,hdf5err)
2688
2689   endif
2690   return
2691
2692 end subroutine ext_phdf5_put_var_td_integer
2693
2694 subroutine ext_phdf5_put_var_td_logical(DataHandle,Element,DateStr,Var,Data,Count,Status)
2695
2696   use wrf_phdf5_data
2697   use ext_phdf5_support_routines
2698   USE HDF5 ! This module contains all necessary modules
2699   implicit none
2700   include 'wrf_status_codes.h'
2701
2702   integer               ,intent(in)             :: DataHandle
2703   character*(*)         ,intent(in)             :: Element
2704   character*(*)         ,intent(in)             :: DateStr
2705   character*(*)         ,intent(in)             :: Var
2706   character(len = 256)                           :: DataSetName
2707   logical               ,intent(in)             :: Data(*)
2708   integer ,dimension(:),allocatable             :: Buffer
2709   integer               ,intent(in)             :: Count
2710   integer               ,intent(out)            :: Status
2711   type(wrf_phdf5_data_handle),pointer            :: DH
2712   integer                                       :: TimeIndex
2713   integer(hid_t)                                :: dset_id
2714   integer(hid_t)                                :: dspaceid
2715   integer(hid_t)                                :: fspaceid
2716   integer(hid_t)                                :: tgroupid
2717   integer(hsize_t),dimension(1)                 :: dims
2718   integer                                       :: hdf5err
2719   integer                                       :: i
2720
2721   call GetDH(DataHandle,DH,Status)
2722   if(Status /= WRF_NO_ERR) then
2723      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
2724      call wrf_debug ( WARN , msg)
2725      return
2726   endif
2727
2728   ! check whether the DateStr is the correct length
2729   call DateCheck(DateStr,Status)
2730   if(Status /= WRF_NO_ERR) then
2731      write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__
2732      call wrf_debug ( WARN , msg)
2733      return
2734   endif
2735
2736   if(DH%FileStatus == WRF_FILE_OPENED_AND_COMMITTED) then
2737
2738      allocate(buffer(count))
2739      do i = 1, count
2740         if(data(i).EQV..TRUE.) then
2741            buffer(i) = 1
2742         else
2743            buffer(i) = 0
2744         endif
2745      enddo
2746
2747      dims(1) = Count
2748      ! Get the time index
2749      call GetAttrTimeIndex('write',DataHandle,DateStr,TimeIndex,Status)
2750      if(Status /= WRF_NO_ERR) then
2751         return
2752      endif
2753
2754      ! Set up dataspace,property list
2755      call GetName(Element,Var,DataSetName,Status)
2756
2757      call setup_wrtd_dataset(DataHandle,DataSetName,DH%EnumID, &
2758           Count,dset_id,dspaceid,           &
2759           fspaceid,tgroupid,TimeIndex,Status)
2760      if(Status /= WRF_NO_ERR) then
2761         return
2762      endif
2763
2764      call h5dwrite_f(dset_id,DH%EnumID,Buffer,dims,hdf5err,dspaceid,&
2765           fspaceid)
2766      if(hdf5err.lt.0) then
2767         Status =  WRF_HDF5_ERR_DATASET_WRITE
2768         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
2769         call wrf_debug ( WARN , msg)
2770         return
2771      endif
2772      call h5dclose_f(dset_id,hdf5err)
2773      call h5sclose_f(dspaceid,hdf5err)
2774      call h5sclose_f(fspaceid,hdf5err)
2775 !     call h5gclose_f(tgroupid,hdf5err)
2776      deallocate(Buffer)
2777   endif
2778   return
2779 end subroutine ext_phdf5_put_var_td_logical
2780
2781 subroutine ext_phdf5_put_var_td_char(DataHandle,Element,DateStr,Var,Data,Status)
2782
2783   use wrf_phdf5_data
2784   use ext_phdf5_support_routines
2785   USE HDF5 ! This module contains all necessary modules
2786   implicit none
2787   include 'wrf_status_codes.h'
2788
2789   integer               ,intent(in)             :: DataHandle
2790   character*(*)         ,intent(in)             :: Element
2791   character*(*)         ,intent(in)             :: DateStr
2792   character*(*)         ,intent(in)             :: Var
2793   character(len = 256)                           :: DataSetName
2794   character*(*)         ,intent(in)             :: Data
2795   integer               ,intent(out)            :: Status
2796   type(wrf_phdf5_data_handle),pointer           :: DH
2797   integer                                       :: TimeIndex
2798   integer(hid_t)                                :: dset_id
2799   integer(hid_t)                                :: dspaceid
2800   integer(hid_t)                                :: fspaceid
2801   integer(hid_t)                                :: tgroupid
2802   integer(hsize_t),dimension(1)                 :: dims
2803   integer                                       :: hdf5err
2804   integer                                       :: i
2805
2806   integer                                       :: str_id
2807   integer                                       :: str_len
2808   integer                                       :: count
2809
2810   call GetDH(DataHandle,DH,Status)
2811   if(Status /= WRF_NO_ERR) then
2812      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
2813      call wrf_debug ( WARN , msg)
2814      return
2815   endif
2816
2817   ! check whether the DateStr is the correct length
2818   call DateCheck(DateStr,Status)
2819   if(Status /= WRF_NO_ERR) then
2820      write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__
2821      call wrf_debug ( WARN , msg)
2822      return
2823   endif
2824
2825   if(DH%FileStatus == WRF_FILE_OPENED_AND_COMMITTED) then
2826
2827      dims(1) = 1
2828
2829      ! Get the time index
2830      call GetAttrTimeIndex('write',DataHandle,DateStr,TimeIndex,Status)
2831      if(Status /= WRF_NO_ERR) then
2832         return
2833      endif
2834
2835      ! make str id
2836      str_len = len_trim(Data)
2837      call make_strid(str_len,str_id,Status)
2838      if(Status /= WRF_NO_ERR) then
2839         return
2840      endif
2841
2842      ! assign count of the string to 1
2843      count = 1
2844
2845      ! Set up dataspace,property list
2846      call GetName(Element,Var,DataSetName,Status)
2847      if(Status /= WRF_NO_ERR) then
2848         return
2849      endif
2850      call setup_wrtd_dataset(DataHandle,DataSetName,str_id, &
2851           count,dset_id,dspaceid,        &
2852           fspaceid,tgroupid,TimeIndex,Status)
2853      if(Status /= WRF_NO_ERR) then
2854         return
2855      endif
2856
2857      call h5dwrite_f(dset_id,str_id,Data,dims,hdf5err,dspaceid,&
2858           fspaceid)
2859      if(hdf5err.lt.0) then
2860         Status =  WRF_HDF5_ERR_DATASET_WRITE
2861         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
2862         call wrf_debug ( WARN , msg)
2863         return
2864      endif
2865
2866      ! close the string id
2867      call h5tclose_f(str_id,hdf5err)
2868      if(hdf5err.lt.0) then
2869         Status =  WRF_HDF5_ERR_DATATYPE
2870         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
2871         call wrf_debug ( WARN , msg)
2872         return
2873      endif
2874      call h5dclose_f(dset_id,hdf5err)
2875      call h5sclose_f(dspaceid,hdf5err)
2876      call h5sclose_f(fspaceid,hdf5err)
2877 !     call h5gclose_f(tgroupid,hdf5err)
2878
2879   endif
2880   return
2881
2882 end subroutine ext_phdf5_put_var_td_char
2883
2884 subroutine ext_phdf5_get_var_td_real(DataHandle,Element,DateStr,Var,Data,Count,OutCount,Status)
2885
2886   use wrf_phdf5_data
2887   use ext_phdf5_support_routines
2888   USE HDF5 ! This module contains all necessary modules
2889   implicit none
2890   include 'wrf_status_codes.h'
2891
2892   integer               ,intent(in)             :: DataHandle
2893   character*(*)         ,intent(in)             :: Element
2894   character*(*)         ,intent(in)             :: DateStr
2895   character*(*)         ,intent(in)             :: Var
2896   character(len =256)                            :: DataSetName
2897   real                  ,intent(out)            :: Data(*)
2898   integer               ,intent(in)             :: Count
2899   integer               ,intent(out)            :: OutCount
2900   integer               ,intent(out)            :: Status
2901   type(wrf_phdf5_data_handle),pointer            :: DH
2902   integer                                       :: TimeIndex
2903   integer(hid_t)                                :: dset_id
2904   integer(hid_t)                                :: dspaceid
2905   integer(hid_t)                                :: memspaceid
2906   integer(hid_t)                                :: tgroupid
2907   integer(hsize_t),dimension(7)                 :: data_dims
2908   integer                                       :: hdf5err
2909
2910   call GetDH(DataHandle,DH,Status)
2911   if(Status /= WRF_NO_ERR) then
2912      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
2913      call wrf_debug ( WARN , msg)
2914      return
2915   endif
2916
2917   ! check whether the DateStr is the correct length
2918   call DateCheck(DateStr,Status)
2919   if(Status /= WRF_NO_ERR) then
2920      write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__
2921      call wrf_debug ( WARN , msg)
2922      return
2923   endif
2924
2925   if(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
2926
2927      ! get the time-dependent attribute name
2928
2929      call GetName(Element,Var,DataSetName,Status)
2930
2931      ! get time index of the time-dependent attribute
2932      call GetAttrTimeIndex('read',DataHandle,DateStr,TimeIndex,Status)
2933      if(Status /= WRF_NO_ERR) then
2934         return
2935      endif
2936
2937      ! For parallel, find the group and obtain the attribute.
2938      ! set up for reading the time-dependent attribute
2939      call setup_rdtd_dataset(DataHandle,DataSetName,H5T_NATIVE_REAL,TimeIndex,&
2940           Count,OutCount,dset_id,memspaceid,dspaceid,tgroupid,&
2941           Status)
2942      if(Status /= WRF_NO_ERR) then
2943         return
2944      endif
2945
2946      data_dims(1) = OutCount
2947
2948      ! read the dataset
2949      call h5dread_f(dset_id,H5T_NATIVE_REAL,data,data_dims,hdf5err, &
2950           memspaceid,dspaceid,H5P_DEFAULT_F)
2951      if(hdf5err.lt.0) then
2952         Status = WRF_HDF5_ERR_DATASET_READ
2953         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
2954         call wrf_debug ( WARN , msg)
2955         return
2956      endif
2957      call h5sclose_f(memspaceid,hdf5err)
2958      call h5sclose_f(dspaceid,hdf5err)
2959      call h5dclose_f(dset_id,hdf5err)
2960      call h5gclose_f(tgroupid,hdf5err)
2961   endif
2962
2963 end subroutine ext_phdf5_get_var_td_real
2964
2965 subroutine ext_phdf5_get_var_td_double(DataHandle,Element,DateStr,Var,Data,&
2966      Count,OutCount,Status)
2967
2968   use wrf_phdf5_data
2969   use ext_phdf5_support_routines
2970   USE HDF5 ! This module contains all necessary modules
2971   implicit none
2972   include 'wrf_status_codes.h'
2973
2974   integer               ,intent(in)             :: DataHandle
2975   character*(*)         ,intent(in)             :: Element
2976   character*(*)         ,intent(in)             :: DateStr
2977   character*(*)         ,intent(in)             :: Var
2978   character(len =256)                            :: DataSetName
2979   real*8                ,intent(out)            :: Data(*)
2980   integer               ,intent(in)             :: Count
2981   integer              ,intent(out)            :: OutCount
2982   integer               ,intent(out)            :: Status
2983   type(wrf_phdf5_data_handle),pointer            :: DH
2984   integer                                       :: TimeIndex
2985   integer(hid_t)                                :: dset_id
2986   integer(hid_t)                                :: dspaceid
2987   integer(hid_t)                                :: memspaceid
2988   integer(hid_t)                                :: tgroupid
2989   integer(hsize_t),dimension(7)                 :: data_dims
2990   integer                                       :: hdf5err
2991
2992   call GetDH(DataHandle,DH,Status)
2993   if(Status /= WRF_NO_ERR) then
2994      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
2995      call wrf_debug ( WARN , msg)
2996      return
2997   endif
2998
2999   ! check whether the DateStr is the correct length
3000   call DateCheck(DateStr,Status)
3001   if(Status /= WRF_NO_ERR) then
3002      write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__
3003      call wrf_debug ( WARN , msg)
3004      return
3005   endif
3006
3007   if(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
3008
3009      ! get the time-dependent attribute name
3010      call GetName(Element,Var,DataSetName,Status)
3011
3012      ! get time index of the time-dependent attribute
3013      call GetAttrTimeIndex('read',DataHandle,DateStr,TimeIndex,Status)
3014      if(Status /= WRF_NO_ERR) then
3015         return
3016      endif
3017
3018      ! set up for reading the time-dependent attribute
3019      call setup_rdtd_dataset(DataHandle,DataSetName,H5T_NATIVE_DOUBLE,TimeIndex,&
3020           Count,OutCount,dset_id,memspaceid,dspaceid,tgroupid,&
3021           Status)
3022      if(Status /= WRF_NO_ERR) then
3023         return
3024      endif
3025
3026      data_dims(1) = OutCount
3027
3028      ! read the dataset
3029      call h5dread_f(dset_id,H5T_NATIVE_DOUBLE,data,data_dims,hdf5err, &
3030           memspaceid,dspaceid,H5P_DEFAULT_F)
3031      if(hdf5err.lt.0) then
3032         Status = WRF_HDF5_ERR_DATASET_READ
3033         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
3034         call wrf_debug ( WARN , msg)
3035         return
3036      endif
3037
3038      call h5sclose_f(memspaceid,hdf5err)
3039      call h5sclose_f(dspaceid,hdf5err)
3040      call h5dclose_f(dset_id,hdf5err)
3041      call h5gclose_f(tgroupid,hdf5err)
3042
3043   endif
3044
3045 end subroutine ext_phdf5_get_var_td_double
3046
3047 subroutine ext_phdf5_get_var_td_integer(DataHandle,Element,DateStr,Var,Data,&
3048      Count,OutCount,Status)
3049
3050   use wrf_phdf5_data
3051   use ext_phdf5_support_routines
3052   USE HDF5 ! This module contains all necessary modules
3053   implicit none
3054   include 'wrf_status_codes.h'
3055
3056   integer               ,intent(in)             :: DataHandle
3057   character*(*)         ,intent(in)             :: Element
3058   character*(*)         ,intent(in)             :: DateStr
3059   character*(*)         ,intent(in)             :: Var
3060   character(len =256)                            :: DataSetName
3061   integer               ,intent(out)             :: Data(*)
3062   integer               ,intent(in)             :: Count
3063   INTEGER               ,intent(out)            :: OutCount
3064   integer               ,intent(out)            :: Status
3065   type(wrf_phdf5_data_handle),pointer            :: DH
3066   integer                                       :: TimeIndex
3067   integer(hid_t)                                :: dset_id
3068   integer(hid_t)                                :: dspaceid
3069   integer(hid_t)                                :: memspaceid
3070   integer(hid_t)                                :: tgroupid
3071   integer(hsize_t),dimension(7)                 :: data_dims
3072   integer                                       :: hdf5err
3073
3074   call GetDH(DataHandle,DH,Status)
3075   if(Status /= WRF_NO_ERR) then
3076      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
3077      call wrf_debug ( WARN , msg)
3078      return
3079   endif
3080
3081   ! check whether the DateStr is the correct length
3082   call DateCheck(DateStr,Status)
3083   if(Status /= WRF_NO_ERR) then
3084      write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__
3085      call wrf_debug ( WARN , msg)
3086      return
3087   endif
3088
3089   if(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
3090
3091      ! get the time-dependent attribute name
3092      call GetName(Element,Var,DataSetName,Status)
3093
3094      ! get time index of the time-dependent attribute
3095      call GetAttrTimeIndex('read',DataHandle,DateStr,TimeIndex,Status)
3096      if(Status /= WRF_NO_ERR) then
3097         return
3098      endif
3099
3100      ! set up for reading the time-dependent attribute
3101      call setup_rdtd_dataset(DataHandle,DataSetName,H5T_NATIVE_INTEGER,TimeIndex,&
3102           Count,OutCount,dset_id,memspaceid,dspaceid,tgroupid,&
3103           Status)
3104      if(Status /= WRF_NO_ERR) then
3105         return
3106      endif
3107
3108      data_dims(1) = OutCount
3109
3110      ! read the dataset
3111      call h5dread_f(dset_id,H5T_NATIVE_INTEGER,data,data_dims,hdf5err, &
3112           memspaceid,dspaceid,H5P_DEFAULT_F)
3113      if(hdf5err.lt.0) then
3114         Status = WRF_HDF5_ERR_DATASET_READ
3115         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
3116         call wrf_debug ( WARN , msg)
3117         return
3118      endif
3119
3120      call h5sclose_f(memspaceid,hdf5err)
3121      call h5sclose_f(dspaceid,hdf5err)
3122      call h5dclose_f(dset_id,hdf5err)
3123      call h5gclose_f(tgroupid,hdf5err)
3124   endif
3125 end subroutine ext_phdf5_get_var_td_integer
3126
3127 subroutine ext_phdf5_get_var_td_logical(DataHandle,Element,DateStr,Var,Data,&
3128      Count,OutCount,Status)
3129   use wrf_phdf5_data
3130   use ext_phdf5_support_routines
3131   USE HDF5 ! This module contains all necessary modules
3132   implicit none
3133   include 'wrf_status_codes.h'
3134
3135   integer               ,intent(in)             :: DataHandle
3136   character*(*)         ,intent(in)             :: Element
3137   character*(*)         ,intent(in)             :: DateStr
3138   character*(*)         ,intent(in)             :: Var
3139   character(len =256)                            :: DataSetName
3140   logical               ,intent(out)            :: Data(*)
3141   integer,         dimension(:),allocatable     :: Buffer
3142   integer               ,intent(in)             :: Count
3143   integer               ,intent(out)            :: OutCount
3144   integer               ,intent(out)            :: Status
3145   type(wrf_phdf5_data_handle),pointer            :: DH
3146   integer                                       :: TimeIndex
3147   integer(hid_t)                                :: dset_id
3148   integer(hid_t)                                :: dspaceid
3149   integer(hid_t)                                :: memspaceid
3150   integer(hid_t)                                :: tgroupid
3151   integer(hsize_t),dimension(7)                 :: data_dims
3152   integer                                       :: hdf5err
3153
3154   call GetDH(DataHandle,DH,Status)
3155   if(Status /= WRF_NO_ERR) then
3156      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
3157      call wrf_debug ( WARN , msg)
3158      return
3159   endif
3160
3161   ! check whether the DateStr is the correct length
3162   call DateCheck(DateStr,Status)
3163   if(Status /= WRF_NO_ERR) then
3164      write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__
3165      call wrf_debug ( WARN , msg)
3166      return
3167   endif
3168
3169   if(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
3170
3171      ! get the time-dependent attribute name
3172      call GetName(Element,Var,DataSetName,Status)
3173
3174      ! get time index of the time-dependent attribute
3175      call GetAttrTimeIndex('read',DataHandle,DateStr,TimeIndex,Status)
3176      if(Status /= WRF_NO_ERR) then
3177         return
3178      endif
3179
3180      ! set up for reading the time-dependent attribute
3181      call setup_rdtd_dataset(DataHandle,DataSetName,DH%EnumID,TimeIndex,&
3182           Count,OutCount,dset_id,memspaceid,dspaceid,&
3183           tgroupid,Status)
3184      if(Status /= WRF_NO_ERR) then
3185         return
3186      endif
3187
3188      data_dims(1) = OutCount
3189      ! read the dataset
3190
3191      allocate(Buffer(OutCount))
3192      call h5dread_f(dset_id,DH%EnumID,buffer,data_dims,hdf5err, &
3193           memspaceid,dspaceid,H5P_DEFAULT_F)
3194      if(hdf5err.lt.0) then
3195         Status = WRF_HDF5_ERR_DATASET_READ
3196         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
3197         call wrf_debug ( WARN , msg)
3198         return
3199      endif
3200      data(1:OutCount) = buffer(1:OutCount) == 1
3201      deallocate(buffer)
3202      call h5sclose_f(memspaceid,hdf5err)
3203      call h5sclose_f(dspaceid,hdf5err)
3204      call h5dclose_f(dset_id,hdf5err)
3205      call h5gclose_f(tgroupid,hdf5err)
3206   endif
3207
3208 end subroutine ext_phdf5_get_var_td_logical
3209
3210 subroutine ext_phdf5_get_var_td_char(DataHandle,Element,DateStr,Var,Data,Status)
3211
3212   use wrf_phdf5_data
3213   use ext_phdf5_support_routines
3214   USE HDF5 ! This module contains all necessary modules
3215   implicit none
3216   include 'wrf_status_codes.h'
3217
3218   integer               ,intent(in)             :: DataHandle
3219   character*(*)         ,intent(in)             :: Element
3220   character*(*)         ,intent(in)             :: DateStr
3221   character*(*)         ,intent(in)             :: Var
3222   character(len =256)                            :: DataSetName
3223   character*(*)         ,intent(out)             :: Data
3224   integer                                       :: Count
3225   integer                                       :: OutCount
3226   integer               ,intent(out)            :: Status
3227   type(wrf_phdf5_data_handle),pointer            :: DH
3228   integer                                       :: TimeIndex
3229   integer(hid_t)                                :: dset_id
3230   integer(hid_t)                                :: dspaceid
3231   integer(hid_t)                                :: memspaceid
3232   integer(hid_t)                                :: tgroupid
3233   integer(hsize_t),dimension(7)                 :: data_dims
3234   integer                                       :: hdf5err
3235
3236   integer(hid_t)                                :: str_id
3237
3238   call GetDH(DataHandle,DH,Status)
3239   if(Status /= WRF_NO_ERR) then
3240      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
3241      call wrf_debug ( WARN , msg)
3242      return
3243   endif
3244
3245   ! check whether the DateStr is the correct length
3246   call DateCheck(DateStr,Status)
3247   if(Status /= WRF_NO_ERR) then
3248      write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__
3249      call wrf_debug ( WARN , msg)
3250      return
3251   endif
3252
3253   if(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
3254
3255      ! get the time-dependent attribute name
3256      call GetName(Element,Var,DataSetName,Status)
3257
3258      ! get time index of the time-dependent attribute
3259      call GetAttrTimeIndex('read',DataHandle,DateStr,TimeIndex,Status)
3260      if(Status /= WRF_NO_ERR) then
3261         return
3262      endif
3263
3264      ! set up for reading the time-dependent attribute
3265      str_id = H5T_NATIVE_CHARACTER
3266      Count  = 1
3267      call setup_rdtd_dataset(DataHandle,DataSetName,str_id,TimeIndex,&
3268           Count,OutCount,dset_id,memspaceid,dspaceid,&
3269           tgroupid,Status)
3270      if(Status /= WRF_NO_ERR) then
3271         return
3272      endif
3273
3274      data_dims(1) = Count
3275
3276      ! read the dataset
3277      call h5dread_f(dset_id,str_id,data,data_dims,hdf5err, &
3278           memspaceid,dspaceid,H5P_DEFAULT_F)
3279      if(hdf5err.lt.0) then
3280         Status = WRF_HDF5_ERR_DATASET_READ
3281         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
3282         call wrf_debug ( WARN , msg)
3283         return
3284      endif
3285      call h5sclose_f(memspaceid,hdf5err)
3286      call h5sclose_f(dspaceid,hdf5err)
3287      call h5dclose_f(dset_id,hdf5err)
3288      call h5gclose_f(tgroupid,hdf5err)
3289   endif
3290
3291 end subroutine ext_phdf5_get_var_td_char
3292
3293 ! obtain the variable time independent attribute with REAL type
3294 subroutine ext_phdf5_get_var_ti_real(DataHandle,Element,Var,Data,Count,OutCount,Status)
3295
3296   use wrf_phdf5_data
3297   use ext_phdf5_support_routines
3298   USE HDF5 ! This module contains all necessary modules
3299   use get_attrid_routine
3300   implicit none
3301   include 'wrf_status_codes.h'
3302
3303   integer               ,intent(in)     :: DataHandle
3304   character*(*)         ,intent(in)     :: Element
3305   character*(*)         ,intent(in)     :: Var
3306   real                  ,intent(out)    :: Data(*)
3307   integer               ,intent(in)     :: Count
3308   integer               ,intent(out)    :: OutCount
3309   integer               ,intent(out)    :: Status
3310   integer(hid_t)                        :: h5_atypeid
3311   integer(hid_t)                        :: h5_aspaceid
3312   integer(hid_t)                        :: h5_attrid
3313   integer(hid_t)                        :: attr_type
3314   integer(hsize_t), dimension(7)        :: h5_dims
3315   integer                               :: hdf5err
3316
3317   attr_type = H5T_NATIVE_REAL
3318
3319   call get_attrid(DataHandle,Element,h5_attrid,Status,Var)
3320   if(Status /= WRF_NO_ERR) then
3321      return
3322   endif
3323
3324   call check_type(DataHandle,attr_type,h5_attrid,Status)
3325   if (status /= WRF_NO_ERR) then
3326      return
3327   endif
3328
3329   call  retrieve_ti_info(DataHandle,h5_attrid,h5_atypeid,&
3330        Count,OutCount,Status)
3331   if(Status /= WRF_NO_ERR) then
3332      return
3333   endif
3334
3335   h5_dims(1) = OutCount
3336   call h5aread_f(h5_attrid,attr_type,data,h5_dims,hdf5err)
3337   if(hdf5err.lt.0) then
3338      Status =  WRF_HDF5_ERR_ATTRIBUTE_READ
3339      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
3340      call wrf_debug ( WARN , msg)
3341      return
3342   endif
3343
3344   return
3345 end subroutine ext_phdf5_get_var_ti_real
3346
3347 ! obtain the variable time independent attribute with REAL8 type
3348 subroutine ext_phdf5_get_var_ti_double(DataHandle,Element,Var,Data,Count,OutCount,Status)
3349
3350   use wrf_phdf5_data
3351   use ext_phdf5_support_routines
3352   USE HDF5 ! This module contains all necessary modules
3353   use get_attrid_routine
3354   implicit none
3355   include 'wrf_status_codes.h'
3356
3357   integer               ,intent(in)     :: DataHandle
3358   character*(*)         ,intent(in)     :: Element
3359   character*(*)         ,intent(in)     :: Var
3360   real*8                ,intent(out)    :: Data(*)
3361   integer               ,intent(in)     :: Count
3362   integer               ,intent(out)    :: OutCount
3363   integer               ,intent(out)    :: Status
3364   integer(hid_t)                        :: h5_atypeid
3365   integer(hid_t)                        :: h5_aspaceid
3366   integer(hid_t)                        :: h5_attrid
3367   integer(hid_t)                        :: attr_type
3368   integer(hsize_t), dimension(7)        :: h5_dims
3369   integer                               :: hdf5err
3370
3371   attr_type = H5T_NATIVE_DOUBLE
3372
3373   call get_attrid(DataHandle,Element,h5_attrid,Status,Var)
3374   if(Status /= WRF_NO_ERR) then
3375      return
3376   endif
3377
3378   call check_type(DataHandle,attr_type,h5_attrid,Status)
3379   if (status /= WRF_NO_ERR) then
3380      return
3381   endif
3382
3383   call  retrieve_ti_info(DataHandle,h5_attrid,h5_atypeid,&
3384        Count,OutCount,Status)
3385   if(Status /= WRF_NO_ERR) then
3386      return
3387   endif
3388
3389   h5_dims(1) = OutCount
3390   call h5aread_f(h5_attrid,attr_type,data,h5_dims,hdf5err)
3391   if(hdf5err.lt.0) then
3392      Status =  WRF_HDF5_ERR_ATTRIBUTE_READ
3393      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
3394      call wrf_debug ( WARN , msg)
3395      return
3396   endif
3397
3398 end subroutine ext_phdf5_get_var_ti_double
3399
3400 ! obtain the variable time independent attribute with integer type
3401 subroutine ext_phdf5_get_var_ti_integer(DataHandle,Element,Var,Data,Count,OutCount,Status)
3402
3403   use wrf_phdf5_data
3404   use ext_phdf5_support_routines
3405   USE HDF5 ! This module contains all necessary modules
3406   use get_attrid_routine
3407   implicit none
3408   include 'wrf_status_codes.h'
3409
3410   integer               ,intent(in)     :: DataHandle
3411   character*(*)         ,intent(in)     :: Element
3412   character*(*)         ,intent(in)     :: Var
3413   integer               ,intent(out)    :: Data(*)
3414   integer               ,intent(in)     :: Count
3415   integer               ,intent(out)    :: OutCount
3416   integer               ,intent(out)    :: Status
3417   integer(hid_t)                        :: h5_atypeid
3418   integer(hid_t)                        :: h5_aspaceid
3419   integer(hid_t)                        :: h5_attrid
3420   integer(hid_t)                        :: attr_type
3421   integer(hsize_t), dimension(7)        :: h5_dims
3422   integer                               :: hdf5err
3423
3424   attr_type = H5T_NATIVE_INTEGER
3425
3426   call get_attrid(DataHandle,Element,h5_attrid,Status,Var)
3427   if (status /= WRF_NO_ERR) then
3428      return
3429   endif
3430
3431   call check_type(DataHandle,attr_type,h5_attrid,Status)
3432   if (status /= WRF_NO_ERR) then
3433      return
3434   endif
3435
3436   call  retrieve_ti_info(DataHandle,h5_attrid,h5_atypeid,&
3437        Count,OutCount,Status)
3438   if (status /= WRF_NO_ERR) then
3439      return
3440   endif
3441
3442   h5_dims(1) = OutCount
3443   call h5aread_f(h5_attrid,attr_type,data,h5_dims,hdf5err)
3444   if(hdf5err.lt.0) then
3445      Status =  WRF_HDF5_ERR_ATTRIBUTE_READ
3446      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
3447      call wrf_debug ( WARN , msg)
3448      return
3449   endif
3450
3451   return
3452
3453 end subroutine ext_phdf5_get_var_ti_integer
3454
3455 ! obtain the variable time independent attribute with logical type
3456 subroutine ext_phdf5_get_var_ti_logical(DataHandle,Element,Var,Data,Count,OutCount,Status)
3457
3458   use wrf_phdf5_data
3459   use ext_phdf5_support_routines
3460   USE HDF5 ! This module contains all necessary modules
3461   use get_attrid_routine
3462   implicit none
3463   include 'wrf_status_codes.h'
3464
3465   integer               ,intent(in)     :: DataHandle
3466   character*(*)         ,intent(in)     :: Element
3467   character*(*)         ,intent(in)     :: Var
3468   logical               ,intent(out)    :: Data(*)
3469   integer, dimension(:),allocatable     :: Buffer
3470   integer               ,intent(in)     :: Count
3471   integer               ,intent(out)    :: OutCount
3472   integer               ,intent(out)    :: Status
3473   integer(hid_t)                        :: h5_atypeid
3474   integer(hid_t)                        :: h5_aspaceid
3475   integer(hid_t)                        :: h5_attrid
3476   integer(hid_t)                        :: attr_type
3477   type(wrf_phdf5_data_handle),pointer    :: DH
3478   integer(hsize_t), dimension(7)        :: h5_dims
3479   integer                               :: hdf5err
3480
3481   call GetDH(DataHandle,DH,Status)
3482   if(Status /= WRF_NO_ERR) then
3483      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
3484      call wrf_debug ( WARN , msg)
3485      return
3486   endif
3487
3488   attr_type = DH%EnumID
3489   call get_attrid(DataHandle,Element,h5_attrid,Status,Var)
3490   if(Status /= WRF_NO_ERR) then
3491      return
3492   endif
3493
3494   call check_type(DataHandle,attr_type,h5_attrid,Status)
3495   if (status /= WRF_NO_ERR) then
3496      return
3497   endif
3498
3499   call  retrieve_ti_info(DataHandle,h5_attrid,h5_atypeid,&
3500        Count,OutCount,Status)
3501   if (status /= WRF_NO_ERR) then
3502      return
3503   endif
3504
3505   h5_dims(1) = OutCount
3506
3507   allocate(buffer(OutCount))
3508   call h5aread_f(h5_attrid,attr_type,buffer,h5_dims,hdf5err)
3509   if(hdf5err.lt.0) then
3510      Status =  WRF_HDF5_ERR_ATTRIBUTE_READ
3511      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
3512      call wrf_debug ( WARN , msg)
3513      deallocate(buffer)
3514      return
3515   endif
3516
3517   Data(1:OutCount) = buffer(1:OutCount)==1
3518   deallocate(buffer)
3519   return
3520
3521 end subroutine ext_phdf5_get_var_ti_logical
3522
3523
3524 ! obtain the domain variable independent attribute with Char type
3525 subroutine ext_phdf5_get_var_ti_char(DataHandle,Element,Var,Data,Status)
3526
3527   use wrf_phdf5_data
3528   use ext_phdf5_support_routines
3529   USE HDF5 ! This module contains all necessary modules
3530   use get_attrid_routine
3531   implicit none
3532   include 'wrf_status_codes.h'
3533
3534   integer               ,intent(in)     :: DataHandle
3535   character*(*)         ,intent(in)     :: Element
3536   character*(*)         ,intent(in)     :: Var
3537   character*(*)         ,intent(out)    :: Data
3538   integer               ,intent(out)    :: Status
3539
3540   integer(hid_t)                        :: h5_atypeid
3541   integer(hid_t)                        :: h5_aspaceid
3542   integer(hid_t)                        :: h5_attrid
3543   integer(hid_t)                        :: attr_type
3544   integer(hsize_t), dimension(7)        :: h5_dims
3545   integer                               :: Count
3546   integer                               :: OutCount
3547   integer                               :: hdf5err
3548
3549   attr_type = H5T_NATIVE_CHARACTER
3550   call get_attrid(DataHandle,Element,h5_attrid,Status,Var)
3551   if (status /= WRF_NO_ERR) then
3552      return
3553   endif
3554
3555   call check_type(DataHandle,attr_type,h5_attrid,Status)
3556   if (status /= WRF_NO_ERR) then
3557      return
3558   endif
3559
3560   call  retrieve_ti_info(DataHandle,h5_attrid,h5_atypeid,&
3561        Count,OutCount,Status)
3562   if (status /= WRF_NO_ERR) then
3563      return
3564   endif
3565
3566   if(OutCount /= 1) then
3567      Status = WRF_HDF5_ERR_ATTRIBUTE_OTHERS
3568   endif
3569   h5_dims(1) = OutCount
3570   call h5aread_f(h5_attrid,h5_atypeid,data,h5_dims,hdf5err)
3571   if(hdf5err.lt.0) then
3572      Status =  WRF_HDF5_ERR_ATTRIBUTE_READ
3573      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
3574      call wrf_debug ( WARN , msg)
3575      return
3576   endif
3577
3578   return
3579
3580 end subroutine ext_phdf5_get_var_ti_char
3581
3582
3583 ! write the domain time independent attribute with real type
3584 subroutine ext_phdf5_put_dom_ti_real(DataHandle,Element,Data,Count,Status)
3585
3586   use wrf_phdf5_data
3587   use ext_phdf5_support_routines
3588   USE HDF5 ! This module contains all necessary modules
3589   implicit none
3590   include 'wrf_status_codes.h'
3591
3592   integer               ,intent(in)     :: DataHandle
3593   character*(*)         ,intent(in)     :: Element
3594   real                  ,intent(in)     :: Data(*)
3595   integer               ,intent(in)     :: Count
3596   integer               ,intent(out)    :: Status
3597
3598   integer(hid_t)                        :: h5_objid
3599   integer(hid_t)                        :: h5_atypeid
3600   integer(hid_t)                        :: h5_aspaceid
3601   integer(hid_t)                        :: h5_attrid
3602   integer(hsize_t), dimension(7)        :: adata_dims
3603   character*3                           :: routine_type
3604   integer                               :: routine_atype
3605   integer                               :: str_flag = 0 ! not a string type
3606   integer(hid_t)                        :: hdf5err
3607   character(VarNameLen)                 :: var
3608
3609   ! Do nothing unless it is time to write time-independent domain metadata.
3610   IF ( .NOT. phdf5_ok_to_put_dom_ti( DataHandle ) ) THEN
3611     Status = WRF_NO_ERR
3612     return
3613   ENDIF
3614
3615   var = 'DUMMY'
3616   routine_type = 'DOM'
3617   routine_atype = WRF_REAL
3618   adata_dims(1) = Count
3619
3620   call create_phdf5_objid(DataHandle,h5_objid,routine_type,var,Status)
3621   if(Status /= WRF_NO_ERR) then
3622      return
3623   endif
3624
3625   call create_phdf5_adtypeid(h5_atypeid,routine_atype,Count,Status)
3626   if(Status /= WRF_NO_ERR) then
3627      return
3628   endif
3629
3630   call create_phdf5_adspaceid(Count,str_flag,h5_aspaceid,Status)
3631   if(Status /= WRF_NO_ERR) then
3632      return
3633   endif
3634
3635   call h5acreate_f(h5_objid,Element,h5_atypeid,h5_aspaceid, &
3636        h5_attrid, hdf5err)
3637   if(hdf5err.lt.0) then
3638      Status =  WRF_HDF5_ERR_ATTRIBUTE_CREATE
3639      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
3640      call wrf_debug ( WARN , msg)
3641      return
3642   endif
3643
3644   call h5awrite_f(h5_attrid,h5_atypeid,Data,adata_dims,hdf5err)
3645   if(hdf5err.lt.0) then
3646      Status =  WRF_HDF5_ERR_ATTRIBUTE_WRITE
3647      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
3648      call wrf_debug ( WARN , msg)
3649      return
3650   endif
3651
3652   call clean_phdf5_attrids(h5_atypeid,h5_aspaceid,h5_attrid,str_flag,Status)
3653   if(Status /= WRF_NO_ERR) then
3654      return
3655   endif
3656
3657   return
3658 end subroutine ext_phdf5_put_dom_ti_real
3659
3660 ! write the domain time independent attribute with integer type
3661 subroutine ext_phdf5_put_dom_ti_integer(DataHandle,Element,Data,Count,Status)
3662
3663   use wrf_phdf5_data
3664   use ext_phdf5_support_routines
3665   USE HDF5 ! This module contains all necessary modules
3666   implicit none
3667   include 'wrf_status_codes.h'
3668
3669   integer               ,intent(in)     :: DataHandle
3670   character*(*)         ,intent(in)     :: Element
3671   integer               ,intent(in)     :: Data(*)
3672   integer               ,intent(in)     :: Count
3673   integer               ,intent(out)    :: Status
3674   integer(hid_t)                        :: h5_objid
3675   integer(hid_t)                        :: h5_atypeid
3676   integer(hid_t)                        :: h5_aspaceid
3677   integer(hid_t)                        :: h5_attrid
3678   integer(hsize_t), dimension(7)        :: adata_dims
3679   character*3                           :: routine_type
3680   integer                               :: routine_atype
3681   integer                               :: str_flag = 0 ! not a string type
3682   integer(hid_t)                        :: hdf5err
3683   character(VarNameLen)                 :: var
3684
3685   ! Do nothing unless it is time to write time-independent domain metadata.
3686   IF ( .NOT. phdf5_ok_to_put_dom_ti( DataHandle ) ) THEN
3687     Status = WRF_NO_ERR
3688     return
3689   ENDIF
3690
3691   var = 'DUMMY'
3692   routine_type = 'DOM'
3693   routine_atype = WRF_INTEGER
3694   adata_dims(1) = Count
3695
3696   call create_phdf5_objid(DataHandle,h5_objid,routine_type,var,Status)
3697   if(Status /= WRF_NO_ERR) then
3698      return
3699   endif
3700
3701   call create_phdf5_adtypeid(h5_atypeid,routine_atype,Count,Status)
3702   if(Status /= WRF_NO_ERR) then
3703      return
3704   endif
3705
3706   call create_phdf5_adspaceid(Count,str_flag,h5_aspaceid,Status)
3707   if(Status /= WRF_NO_ERR) then
3708      return
3709   endif
3710
3711   call h5acreate_f(h5_objid,Element,h5_atypeid,h5_aspaceid, &
3712        h5_attrid, hdf5err)
3713   if(hdf5err.lt.0) then
3714      Status =  WRF_HDF5_ERR_ATTRIBUTE_CREATE
3715      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
3716      call wrf_debug ( WARN , msg)
3717      return
3718   endif
3719
3720   call h5awrite_f(h5_attrid,h5_atypeid,Data,adata_dims,hdf5err)
3721   if(hdf5err.lt.0) then
3722      Status =  WRF_HDF5_ERR_ATTRIBUTE_WRITE
3723      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
3724      call wrf_debug ( WARN , msg)
3725      return
3726   endif
3727
3728   call clean_phdf5_attrids(h5_atypeid,h5_aspaceid,h5_attrid,str_flag,Status)
3729   if(Status /= WRF_NO_ERR) then
3730      return
3731   endif
3732
3733   return
3734 end subroutine ext_phdf5_put_dom_ti_integer
3735
3736 ! write the domain time independent attribute with double type
3737 subroutine ext_phdf5_put_dom_ti_double(DataHandle,Element,Data,Count,Status)
3738
3739   use wrf_phdf5_data
3740   use ext_phdf5_support_routines
3741   USE HDF5 ! This module contains all necessary modules
3742   implicit none
3743   include 'wrf_status_codes.h'
3744
3745   integer               ,intent(in)     :: DataHandle
3746   character*(*)         ,intent(in)     :: Element
3747   real*8                ,intent(in)     :: Data(*)
3748   integer               ,intent(in)     :: Count
3749   integer               ,intent(out)    :: Status
3750   integer(hid_t)                        :: h5_objid
3751   integer(hid_t)                        :: h5_atypeid
3752   integer(hid_t)                        :: h5_aspaceid
3753   integer(hid_t)                        :: h5_attrid
3754   integer(hsize_t), dimension(7)        :: adata_dims
3755
3756   character*3                           :: routine_type
3757   integer                               :: routine_atype
3758   integer                               :: str_flag = 0 ! not a string type
3759   integer(hid_t)                        :: hdf5err
3760   character(VarNameLen)                 :: var
3761
3762   ! Do nothing unless it is time to write time-independent domain metadata.
3763   IF ( .NOT. phdf5_ok_to_put_dom_ti( DataHandle ) ) THEN
3764     Status = WRF_NO_ERR
3765     return
3766   ENDIF
3767
3768   var           = 'DUMMY'
3769   routine_type  = 'DOM'
3770   routine_atype = WRF_DOUBLE
3771   adata_dims(1) = Count
3772
3773   call create_phdf5_objid(DataHandle,h5_objid,routine_type,var,Status)
3774   if(Status /= WRF_NO_ERR) then
3775      return
3776   endif
3777
3778   call create_phdf5_adtypeid(h5_atypeid,routine_atype,Count,Status)
3779   if(Status /= WRF_NO_ERR) then
3780      return
3781   endif
3782
3783   call create_phdf5_adspaceid(Count,str_flag,h5_aspaceid,Status)
3784   if(Status /= WRF_NO_ERR) then
3785      return
3786   endif
3787
3788   call h5acreate_f(h5_objid,Element,h5_atypeid,h5_aspaceid, &
3789        h5_attrid, hdf5err)
3790   if(hdf5err.lt.0) then
3791      Status =  WRF_HDF5_ERR_ATTRIBUTE_CREATE
3792      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
3793      call wrf_debug ( WARN , msg)
3794      return
3795   endif
3796
3797   call h5awrite_f(h5_attrid,h5_atypeid,Data,adata_dims,hdf5err)
3798   if(hdf5err.lt.0) then
3799      Status =  WRF_HDF5_ERR_ATTRIBUTE_WRITE
3800      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
3801      call wrf_debug ( WARN , msg)
3802      return
3803   endif
3804
3805   call clean_phdf5_attrids(h5_atypeid,h5_aspaceid,h5_attrid,str_flag,Status)
3806   if(Status /= WRF_NO_ERR) then
3807      return
3808   endif
3809   return
3810
3811 end subroutine ext_phdf5_put_dom_ti_double
3812
3813 ! write the domain time independent attribute with logical type
3814 subroutine ext_phdf5_put_dom_ti_logical(DataHandle,Element,Data,Count,Status)
3815
3816   use wrf_phdf5_data
3817   use ext_phdf5_support_routines
3818   USE HDF5 ! This module contains all necessary modules
3819   implicit none
3820   include 'wrf_status_codes.h'
3821
3822   integer               ,intent(in)      :: DataHandle
3823   character*(*)         ,intent(in)      :: Element
3824   logical               ,intent(in)      :: Data(*)
3825   integer     ,dimension(:),allocatable  :: Buffer
3826   integer               ,intent(in)      :: Count
3827   integer               ,intent(out)     :: Status
3828
3829   integer                                :: i
3830   integer(hid_t)                         :: h5_objid
3831   integer(hid_t)                         :: h5_atypeid
3832   integer(hid_t)                         :: h5_aspaceid
3833   integer(hid_t)                         :: h5_attrid
3834   integer(hsize_t), dimension(7)         :: adata_dims
3835
3836   character*3                            :: routine_type
3837   integer                                :: routine_atype
3838   integer                                :: str_flag = 0 ! not a string type
3839   integer(hid_t)                         :: hdf5err
3840   character(VarNameLen)                  :: var
3841
3842   ! Do nothing unless it is time to write time-independent domain metadata.
3843   IF ( .NOT. phdf5_ok_to_put_dom_ti( DataHandle ) ) THEN
3844     Status = WRF_NO_ERR
3845     return
3846   ENDIF
3847
3848   var           = 'DUMMY'
3849   routine_type  = 'DOM'
3850   routine_atype = WRF_LOGICAL
3851   adata_dims(1) = Count
3852
3853   allocate(Buffer(Count))
3854
3855   do i = 1,Count
3856      if(Data(i) .EQV. .TRUE.) then
3857         Buffer(i) = 1
3858      else
3859         Buffer(i) = 0
3860      endif
3861   enddo
3862
3863   call create_phdf5_objid(DataHandle,h5_objid,routine_type,var,Status)
3864   if(Status /= WRF_NO_ERR) then
3865      return
3866   endif
3867
3868   call create_phdf5_adtypeid(h5_atypeid,routine_atype,Count,Status,DataHandle)
3869   if(Status /= WRF_NO_ERR) then
3870      return
3871   endif
3872
3873   call create_phdf5_adspaceid(Count,str_flag,h5_aspaceid,Status)
3874   if(Status /= WRF_NO_ERR) then
3875      return
3876   endif
3877
3878   call h5acreate_f(h5_objid,Element,h5_atypeid,h5_aspaceid, &
3879        h5_attrid, hdf5err)
3880   if(hdf5err.lt.0) then
3881      Status =  WRF_HDF5_ERR_ATTRIBUTE_CREATE
3882      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
3883      call wrf_debug ( WARN , msg)
3884      deallocate(buffer)
3885      return
3886   endif
3887
3888   call h5awrite_f(h5_attrid,h5_atypeid,Buffer,adata_dims,hdf5err)
3889   if(hdf5err.lt.0) then
3890      Status =  WRF_HDF5_ERR_ATTRIBUTE_WRITE
3891      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
3892      call wrf_debug ( WARN , msg)
3893      deallocate(buffer)
3894      return
3895   endif
3896
3897   call clean_phdf5_attrids(h5_atypeid,h5_aspaceid,h5_attrid,str_flag,Status)
3898   if(Status /= WRF_NO_ERR) then
3899      return
3900   endif
3901
3902   deallocate(Buffer)
3903
3904 end subroutine ext_phdf5_put_dom_ti_logical
3905
3906
3907 ! write the domain time independent attribute with char type
3908 subroutine ext_phdf5_put_dom_ti_char(DataHandle,Element,Data,Status)
3909
3910   use wrf_phdf5_data
3911   use ext_phdf5_support_routines
3912   USE HDF5 ! This module contains all necessary modules
3913   implicit none
3914   include 'wrf_status_codes.h'
3915
3916 !!!! Need more work.
3917   integer               ,intent(in)     :: DataHandle
3918   character*(*)         ,intent(in)     :: Element
3919   character*(*)         ,intent(in)     :: Data
3920   integer                               :: Count ! always 1 for char
3921   integer               ,intent(out)    :: Status
3922
3923   integer(hid_t)                        :: h5_objid
3924   integer(hid_t)                        :: h5_atypeid
3925   integer(hid_t)                        :: h5_aspaceid
3926   integer(hid_t)                        :: h5_attrid
3927   integer(hsize_t), dimension(7)        :: adata_dims
3928   character*3                           :: routine_type
3929   integer                               :: routine_atype
3930   integer                               :: str_flag = 1 ! is a string type
3931   integer(hid_t)                        :: hdf5err
3932   integer                               :: len_str
3933   character(VarNameLen)                 :: var
3934   character(1)                          :: RepData =' '
3935
3936   ! Do nothing unless it is time to write time-independent domain metadata.
3937   IF ( .NOT. phdf5_ok_to_put_dom_ti( DataHandle ) ) THEN
3938     Status = WRF_NO_ERR
3939     return
3940   ENDIF
3941
3942   Count = 1
3943   var = 'DUMMY'
3944   routine_type = 'DOM'
3945   routine_atype = WRF_CHARACTER
3946   adata_dims(1) = Count
3947
3948   call create_phdf5_objid(DataHandle,h5_objid,routine_type,var,Status)
3949   if(Status /= WRF_NO_ERR) then
3950      return
3951   endif
3952
3953   ! This part may need more work, a special case is that the length of the
3954   ! string may be 0, HDF5 cannot handle 0 length string(?),so set the length
3955   ! to 1
3956
3957   len_str = len_trim(Data)
3958   if(len_str == 0) then
3959      len_str = 1
3960   endif
3961
3962   call create_phdf5_adtypeid(h5_atypeid,routine_atype,len_str,Status)
3963   if(Status /= WRF_NO_ERR) then
3964      return
3965   endif
3966
3967   call create_phdf5_adspaceid(Count,str_flag,h5_aspaceid,Status)
3968   if(Status /= WRF_NO_ERR) then
3969      return
3970   endif
3971
3972   call h5acreate_f(h5_objid,Element,h5_atypeid,h5_aspaceid, &
3973        h5_attrid, hdf5err)
3974   if(hdf5err.lt.0) then
3975      Status =  WRF_HDF5_ERR_ATTRIBUTE_CREATE
3976      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
3977      call wrf_debug ( WARN , msg)
3978      return
3979   endif
3980
3981
3982   if(len_trim(Data) == 0) then
3983
3984      call h5awrite_f(h5_attrid,h5_atypeid,RepData,adata_dims,hdf5err)
3985      if(hdf5err.lt.0) then
3986         Status =  WRF_HDF5_ERR_ATTRIBUTE_WRITE
3987         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
3988         call wrf_debug ( WARN , msg)
3989         return
3990      endif
3991   else
3992
3993      call h5awrite_f(h5_attrid,h5_atypeid,trim(Data),adata_dims,hdf5err)
3994      if(hdf5err.lt.0) then
3995         Status =  WRF_HDF5_ERR_ATTRIBUTE_WRITE
3996         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
3997         call wrf_debug ( WARN , msg)
3998         return
3999      endif
4000   endif
4001
4002   call clean_phdf5_attrids(h5_atypeid,h5_aspaceid,h5_attrid,str_flag,Status)
4003   if(Status /= WRF_NO_ERR) then
4004      return
4005   endif
4006
4007   return
4008 end subroutine ext_phdf5_put_dom_ti_char
4009
4010 ! write the variable time independent attribute with real type
4011 subroutine ext_phdf5_put_var_ti_real(DataHandle,Element,Var,Data,Count,Status)
4012
4013   use wrf_phdf5_data
4014   use ext_phdf5_support_routines
4015   USE HDF5 ! This module contains all necessary modules
4016   implicit none
4017   include 'wrf_status_codes.h'
4018
4019   integer               ,intent(in)     :: DataHandle
4020   character*(*)         ,intent(in)     :: Element
4021   character*(*)         ,intent(in)     :: Var
4022   real                  ,intent(in)     :: Data(*)
4023   integer               ,intent(in)     :: Count
4024   integer               ,intent(out)    :: Status
4025
4026   integer(hid_t)                        :: h5_objid
4027   integer(hid_t)                        :: h5_atypeid
4028   integer(hid_t)                        :: h5_aspaceid
4029   integer(hid_t)                        :: h5_attrid
4030   integer(hsize_t), dimension(7)        :: adata_dims
4031   character*3                           :: routine_type
4032   integer                               :: routine_atype
4033   integer                               :: str_flag = 0 ! not a string type
4034   integer(hid_t)                        :: hdf5err
4035   type(wrf_phdf5_data_handle),pointer    :: DH
4036
4037
4038   routine_type = 'VAR'
4039   routine_atype = WRF_REAL
4040   adata_dims(1) = Count
4041
4042   call GetDH(DataHandle,DH,Status)
4043   if(Status /= WRF_NO_ERR) then
4044      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4045      call wrf_debug ( WARN , msg)
4046      return
4047   endif
4048
4049   ! The following two checks must be here to avoid duplicating attributes
4050   if (DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
4051      Status = WRF_NO_ERR
4052      return
4053   endif
4054   if(DH%TimeIndex > 1) then
4055      Status = WRF_NO_ERR
4056      return
4057   endif
4058
4059   call create_phdf5_objid(DataHandle,h5_objid,routine_type,Var,Status)
4060   if(Status /= WRF_NO_ERR) then
4061      return
4062   endif
4063
4064   call create_phdf5_adtypeid(h5_atypeid,routine_atype,Count,Status)
4065   if(Status /= WRF_NO_ERR) then
4066      return
4067   endif
4068
4069   call create_phdf5_adspaceid(Count,str_flag,h5_aspaceid,Status)
4070   if(Status /= WRF_NO_ERR) then
4071      return
4072   endif
4073
4074   call h5acreate_f(h5_objid,Element,h5_atypeid,h5_aspaceid, &
4075        h5_attrid, hdf5err)
4076   if(hdf5err.lt.0) then
4077      Status =  WRF_HDF5_ERR_ATTRIBUTE_CREATE
4078      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4079      call wrf_debug ( WARN , msg)
4080      return
4081   endif
4082
4083   call h5awrite_f(h5_attrid,h5_atypeid,Data,adata_dims,hdf5err)
4084   if(hdf5err.lt.0) then
4085      Status =  WRF_HDF5_ERR_ATTRIBUTE_WRITE
4086      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4087      call wrf_debug ( WARN , msg)
4088      return
4089   endif
4090
4091   call clean_phdf5_attrids(h5_atypeid,h5_aspaceid,h5_attrid,str_flag,Status)
4092   if(Status /= WRF_NO_ERR) then
4093      return
4094   endif
4095
4096   return
4097 end subroutine ext_phdf5_put_var_ti_real
4098
4099 ! write the variable time independent attribute with double type
4100 subroutine ext_phdf5_put_var_ti_double(DataHandle,Element,Var,Data,Count,Status)
4101
4102   use wrf_phdf5_data
4103   use ext_phdf5_support_routines
4104   USE HDF5 ! This module contains all necessary modules
4105   implicit none
4106   include 'wrf_status_codes.h'
4107
4108   integer               ,intent(in)     :: DataHandle
4109   character*(*)         ,intent(in)     :: Element
4110   real*8                ,intent(in)     :: Data(*)
4111   character*(*)         ,intent(in)     :: Var
4112   integer               ,intent(in)     :: Count
4113   integer               ,intent(out)    :: Status
4114
4115   integer(hid_t)                        :: h5_objid
4116   integer(hid_t)                        :: h5_atypeid
4117   integer(hid_t)                        :: h5_aspaceid
4118   integer(hid_t)                        :: h5_attrid
4119   integer(hsize_t), dimension(7)        :: adata_dims
4120
4121   character*3                           :: routine_type
4122   integer                               :: routine_atype
4123   integer                               :: str_flag = 0 ! not a string type
4124   integer(hid_t)                        :: hdf5err
4125   type(wrf_phdf5_data_handle),pointer    :: DH
4126
4127   routine_type  = 'VAR'
4128   routine_atype = WRF_DOUBLE
4129   adata_dims(1) = Count
4130
4131   call GetDH(DataHandle,DH,Status)
4132   if(Status /= WRF_NO_ERR) then
4133      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4134      call wrf_debug ( WARN , msg)
4135      return
4136   endif
4137
4138   if (DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
4139      Status = WRF_NO_ERR
4140      return
4141   endif
4142   if(DH%TimeIndex > 1) then
4143      Status = WRF_NO_ERR
4144      return
4145   endif
4146
4147   call create_phdf5_objid(DataHandle,h5_objid,routine_type,Var,Status)
4148   if(Status /= WRF_NO_ERR) then
4149      return
4150   endif
4151
4152   call create_phdf5_adtypeid(h5_atypeid,routine_atype,Count,Status)
4153   if(Status /= WRF_NO_ERR) then
4154      return
4155   endif
4156
4157   call create_phdf5_adspaceid(Count,str_flag,h5_aspaceid,Status)
4158   if(Status /= WRF_NO_ERR) then
4159      return
4160   endif
4161
4162   call h5acreate_f(h5_objid,Element,h5_atypeid,h5_aspaceid, &
4163        h5_attrid, hdf5err)
4164   if(hdf5err.lt.0) then
4165      Status =  WRF_HDF5_ERR_ATTRIBUTE_CREATE
4166      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4167      call wrf_debug ( WARN , msg)
4168      return
4169   endif
4170
4171
4172   call h5awrite_f(h5_attrid,h5_atypeid,Data,adata_dims,hdf5err)
4173   if(hdf5err.lt.0) then
4174      Status =  WRF_HDF5_ERR_ATTRIBUTE_CREATE
4175      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4176      call wrf_debug ( WARN , msg)
4177      return
4178   endif
4179
4180   call clean_phdf5_attrids(h5_atypeid,h5_aspaceid,h5_attrid,str_flag,Status)
4181   if(Status /= WRF_NO_ERR) then
4182      return
4183   endif
4184
4185   return
4186
4187 end subroutine ext_phdf5_put_var_ti_double
4188
4189 ! write the variable time independent attribute with integer type
4190 subroutine ext_phdf5_put_var_ti_integer(DataHandle,Element,Var,Data,Count,Status)
4191
4192   use wrf_phdf5_data
4193   use ext_phdf5_support_routines
4194   USE HDF5 ! This module contains all necessary modules
4195   implicit none
4196   include 'wrf_status_codes.h'
4197
4198   integer               ,intent(in)     :: DataHandle
4199   character*(*)         ,intent(in)     :: Element
4200   character*(*)         ,intent(in)     :: Var
4201   integer               ,intent(in)     :: Data(*)
4202   integer               ,intent(in)     :: Count
4203   integer               ,intent(out)    :: Status
4204
4205   integer(hid_t)                        :: h5_objid
4206   integer(hid_t)                        :: h5_atypeid
4207   integer(hid_t)                        :: h5_aspaceid
4208   integer(hid_t)                        :: h5_attrid
4209   integer(hsize_t), dimension(7)        :: adata_dims
4210
4211   character*3                           :: routine_type
4212   integer                               :: routine_atype
4213   integer                               :: str_flag = 0 ! not a string type
4214   integer(hid_t)                        :: hdf5err
4215   type(wrf_phdf5_data_handle),pointer    :: DH
4216
4217   routine_type = 'VAR'
4218   routine_atype = WRF_INTEGER
4219   adata_dims(1) = Count
4220
4221   call GetDH(DataHandle,DH,Status)
4222   if(Status /= WRF_NO_ERR) then
4223      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4224      call wrf_debug ( WARN , msg)
4225      return
4226   endif
4227
4228   ! The following two checks must be here to avoid duplicating attributes
4229   if (DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
4230      Status = WRF_NO_ERR
4231      return
4232   endif
4233   if(DH%TimeIndex > 1) then
4234      Status = WRF_NO_ERR
4235      return
4236   endif
4237
4238   call create_phdf5_objid(DataHandle,h5_objid,routine_type,Var,Status)
4239   if(Status /= WRF_NO_ERR) then
4240      return
4241   endif
4242
4243   call create_phdf5_adtypeid(h5_atypeid,routine_atype,Count,Status)
4244   if(Status /= WRF_NO_ERR) then
4245      return
4246   endif
4247
4248   call create_phdf5_adspaceid(Count,str_flag,h5_aspaceid,Status)
4249   if(Status /= WRF_NO_ERR) then
4250      return
4251   endif
4252
4253   call h5acreate_f(h5_objid,Element,h5_atypeid,h5_aspaceid, &
4254        h5_attrid, hdf5err)
4255   if(hdf5err.lt.0) then
4256      Status =  WRF_HDF5_ERR_ATTRIBUTE_CREATE
4257      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4258      call wrf_debug ( WARN , msg)
4259      return
4260   endif
4261
4262
4263   call h5awrite_f(h5_attrid,h5_atypeid,Data,adata_dims,hdf5err)
4264   if(hdf5err.lt.0) then
4265      Status =  WRF_HDF5_ERR_ATTRIBUTE_WRITE
4266      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4267      call wrf_debug ( WARN , msg)
4268      return
4269   endif
4270
4271
4272   call clean_phdf5_attrids(h5_atypeid,h5_aspaceid,h5_attrid,str_flag,Status)
4273   if(Status /= WRF_NO_ERR) then
4274      return
4275   endif
4276
4277   return
4278 end subroutine ext_phdf5_put_var_ti_integer
4279
4280
4281 ! write the variable time independent attribute with logical type
4282 subroutine ext_phdf5_put_var_ti_logical(DataHandle,Element,Var,Data,Count,Status)
4283
4284   use wrf_phdf5_data
4285   use ext_phdf5_support_routines
4286   USE HDF5 ! This module contains all necessary modules
4287   implicit none
4288   include 'wrf_status_codes.h'
4289
4290   integer               ,intent(in)     :: DataHandle
4291   character*(*)         ,intent(in)     :: Element
4292   character*(*)         ,intent(in)     :: Var
4293   logical               ,intent(in)     :: Data(*)
4294   integer     ,dimension(:),allocatable :: Buffer
4295   integer               ,intent(in)     :: Count
4296   integer               ,intent(out)    :: Status
4297
4298   integer                                :: i
4299   integer(hid_t)                        :: h5_objid
4300   integer(hid_t)                        :: h5_atypeid
4301   integer(hid_t)                        :: h5_aspaceid
4302   integer(hid_t)                        :: h5_attrid
4303   integer(hsize_t), dimension(7)        :: adata_dims
4304
4305   character*3                           :: routine_type
4306   integer                               :: routine_atype
4307   integer                               :: str_flag = 0 ! not a string type
4308   integer(hid_t)                        :: hdf5err
4309   type(wrf_phdf5_data_handle),pointer    :: DH
4310
4311   routine_type = 'VAR'
4312   routine_atype = WRF_LOGICAL
4313   adata_dims(1) = Count
4314
4315   allocate(Buffer(Count))
4316
4317   do i = 1,Count
4318      if(Data(i) .EQV. .TRUE.) then
4319         Buffer(i) = 1
4320      else
4321         Buffer(i) = 0
4322      endif
4323   enddo
4324
4325   call GetDH(DataHandle,DH,Status)
4326   if(Status /= WRF_NO_ERR) then
4327      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4328      call wrf_debug ( WARN , msg)
4329      return
4330   endif
4331
4332   ! The following two checks must be here to avoid duplicating attributes
4333   if (DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
4334      Status = WRF_NO_ERR
4335      return
4336   endif
4337
4338   if(DH%TimeIndex > 1) then
4339      Status = WRF_NO_ERR
4340      return
4341   endif
4342
4343   call create_phdf5_objid(DataHandle,h5_objid,routine_type,var,Status)
4344   if(Status /= WRF_NO_ERR) then
4345      return
4346   endif
4347
4348   call create_phdf5_adtypeid(h5_atypeid,routine_atype,Count,Status)
4349   if(Status /= WRF_NO_ERR) then
4350      return
4351   endif
4352
4353   call create_phdf5_adspaceid(Count,str_flag,h5_aspaceid,Status)
4354   if(Status /= WRF_NO_ERR) then
4355      return
4356   endif
4357
4358   call h5acreate_f(h5_objid,Element,h5_atypeid,h5_aspaceid, &
4359        h5_attrid, hdf5err)
4360   if(hdf5err.lt.0) then
4361      Status =  WRF_HDF5_ERR_ATTRIBUTE_CREATE
4362      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4363      call wrf_debug ( WARN , msg)
4364      deallocate(buffer)
4365      return
4366   endif
4367
4368
4369   call h5awrite_f(h5_attrid,h5_atypeid,Buffer,adata_dims,hdf5err)
4370   if(hdf5err.lt.0) then
4371      Status =  WRF_HDF5_ERR_ATTRIBUTE_WRITE
4372      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4373      call wrf_debug ( WARN , msg)
4374      deallocate(buffer)
4375      return
4376   endif
4377
4378   call clean_phdf5_attrids(h5_atypeid,h5_aspaceid,h5_attrid,str_flag,Status)
4379   if(Status /= WRF_NO_ERR) then
4380      return
4381   endif
4382
4383   return
4384 end subroutine ext_phdf5_put_var_ti_logical
4385
4386 ! write the variable time independent attribute with char type
4387 subroutine ext_phdf5_put_var_ti_char(DataHandle,Element,Var,Data,Status)
4388
4389   use wrf_phdf5_data
4390   use ext_phdf5_support_routines
4391   USE HDF5 ! This module contains all necessary modules
4392   implicit none
4393   include 'wrf_status_codes.h'
4394
4395   integer               ,intent(in)     :: DataHandle
4396   character*(*)         ,intent(in)     :: Element
4397   character*(*)         ,intent(in)     :: Data
4398   character*(*)         ,intent(in)     :: Var
4399   integer                               :: Count
4400   integer               ,intent(out)    :: Status
4401   integer(hid_t)                        :: h5_objid
4402   integer(hid_t)                        :: h5_atypeid
4403   integer(hid_t)                        :: h5_aspaceid
4404   integer(hid_t)                        :: h5_attrid
4405   integer(hsize_t), dimension(7)        :: adata_dims
4406
4407   character*3                           :: routine_type
4408   integer                               :: routine_atype
4409   integer                               :: str_flag = 1 ! IS  string type
4410   integer(hid_t)                        :: hdf5err
4411   integer                               :: len_str
4412   character(1)                          :: RepData = ' '
4413   type(wrf_phdf5_data_handle),pointer    :: DH
4414
4415   Count         = 1
4416   routine_type  = 'VAR'
4417   routine_atype = WRF_CHARACTER
4418   adata_dims(1) = Count
4419
4420   call GetDH(DataHandle,DH,Status)
4421   if(Status /= WRF_NO_ERR) then
4422      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__, &
4423           ', line', __LINE__
4424      call wrf_debug ( WARN , msg)
4425      return
4426   endif
4427
4428   ! The following two checks must be here to avoid duplicating attributes
4429   if (DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
4430      Status = WRF_NO_ERR
4431      return
4432   endif
4433
4434   if(DH%TimeIndex > 1) then
4435      Status = WRF_NO_ERR
4436      return
4437   endif
4438
4439   call create_phdf5_objid(DataHandle,h5_objid,routine_type,Var,Status)
4440   if(Status /= WRF_NO_ERR) then
4441      return
4442   endif
4443
4444   len_str = len_trim(Data)
4445
4446   if(len_str .eq. 0) then
4447      len_str = 1
4448   endif
4449
4450   call create_phdf5_adtypeid(h5_atypeid,routine_atype,len_str,Status)
4451   if(Status /= WRF_NO_ERR) then
4452      return
4453   endif
4454
4455   call create_phdf5_adspaceid(Count,str_flag,h5_aspaceid,Status)
4456   if(Status /= WRF_NO_ERR) then
4457      return
4458   endif
4459
4460   call h5acreate_f(h5_objid,Element,h5_atypeid,h5_aspaceid, &
4461        h5_attrid, hdf5err)
4462   if(hdf5err.lt.0) then
4463      Status =  WRF_HDF5_ERR_ATTRIBUTE_CREATE
4464      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4465      call wrf_debug ( WARN , msg)
4466      return
4467   endif
4468
4469   if(len_trim(Data) == 0) then
4470
4471      call h5awrite_f(h5_attrid,h5_atypeid,RepData,adata_dims,hdf5err)
4472      if(hdf5err.lt.0) then
4473         Status =  WRF_HDF5_ERR_ATTRIBUTE_WRITE
4474         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4475         call wrf_debug ( WARN , msg)
4476         return
4477      endif
4478   else
4479      call h5awrite_f(h5_attrid,h5_atypeid,trim(Data),adata_dims,hdf5err)
4480      if(hdf5err.lt.0) then
4481         Status =  WRF_HDF5_ERR_ATTRIBUTE_WRITE
4482         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4483         call wrf_debug ( WARN , msg)
4484         return
4485      endif
4486   endif
4487
4488   call clean_phdf5_attrids(h5_atypeid,h5_aspaceid,h5_attrid,str_flag,Status)
4489   if(Status /= WRF_NO_ERR) then
4490      return
4491   endif
4492
4493   return
4494 end subroutine ext_phdf5_put_var_ti_char
4495
4496
4497
4498 ! This routine will retrieve the dimensional table, should be useful
4499 ! for tool developers.
4500
4501 subroutine retrieve_table(DataHandle,Status)
4502
4503   use wrf_phdf5_data
4504   use ext_phdf5_support_routines
4505   use hdf5
4506   implicit none
4507   include 'wrf_status_codes.h'
4508
4509   character*256,dimension(MaxTabDims)    :: dim_name
4510   integer,dimension(:),allocatable      :: length
4511   integer,dimension(:),allocatable      :: unlimited
4512   integer, intent(in)                   :: DataHandle
4513   integer, intent(out)                  :: Status
4514
4515   integer(hid_t)                        :: dset_id
4516   integer(hid_t)                        :: dataspace_id
4517   integer(hid_t)                        :: dtstr_id
4518   integer(hid_t)                        :: dt1_id
4519   integer(hid_t)                        :: dtint1_id
4520   integer(hid_t)                        :: dtint2_id
4521   integer(size_t)                       :: type_sizei
4522   integer(size_t)                       :: offset
4523   integer                               :: table_length
4524   integer(size_t)                       :: string_size
4525   integer(hsize_t),dimension(7)         :: data_dims
4526   integer(hsize_t)                      :: table_size
4527   integer                               :: i
4528   integer                               :: hdf5err
4529
4530   type(wrf_phdf5_data_handle),pointer    :: DH
4531
4532   call GetDH(DataHandle,DH,Status)
4533   if(Status /= WRF_NO_ERR) then
4534      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4535      call wrf_debug ( WARN , msg)
4536      return
4537   endif
4538
4539   call h5dopen_f(DH%DimGroupID,"h5dim_table",dset_id,hdf5err)
4540   if(hdf5err.lt.0) then
4541      Status =  WRF_HDF5_ERR_DATASET_OPEN
4542      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4543      call wrf_debug ( WARN , msg)
4544      return
4545   endif
4546
4547   call h5dget_space_f(dset_id,dataspace_id,hdf5err)
4548   if(hdf5err.lt.0) then
4549      Status =  WRF_HDF5_ERR_DATASPACE
4550      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4551      call wrf_debug ( WARN , msg)
4552      return
4553   endif
4554
4555   call h5sget_simple_extent_npoints_f(dataspace_id,table_size,hdf5err)
4556   if(hdf5err.lt.0) then
4557      Status =  WRF_HDF5_ERR_DATASPACE
4558      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4559      call wrf_debug ( WARN , msg)
4560      return
4561   endif
4562
4563   data_dims(1) = table_size
4564   allocate(length(table_size))
4565   allocate(unlimited(table_size))
4566
4567
4568   ! the name of the dimension
4569   call h5tcopy_f(H5T_NATIVE_CHARACTER,dtstr_id,hdf5err)
4570   if(hdf5err.lt.0) then
4571      Status =  WRF_HDF5_ERR_DATATYPE
4572      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4573      call wrf_debug ( WARN , msg)
4574      deallocate(length)
4575      deallocate(unlimited)
4576      return
4577   endif
4578
4579   string_size = 256
4580   call h5tset_size_f(dtstr_id,string_size,hdf5err)
4581   if(hdf5err.lt.0) then
4582      Status =  WRF_HDF5_ERR_DATATYPE
4583      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4584      call wrf_debug ( WARN , msg)
4585      deallocate(length)
4586      deallocate(unlimited)
4587      return
4588   endif
4589
4590   call h5tcreate_f(H5T_COMPOUND_F,string_size,dt1_id,hdf5err)
4591   if(hdf5err.lt.0) then
4592      Status =  WRF_HDF5_ERR_DATATYPE
4593      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4594      call wrf_debug ( WARN , msg)
4595      deallocate(length)
4596      deallocate(unlimited)
4597      return
4598   endif
4599
4600   offset = 0
4601   call h5tinsert_f(dt1_id,"dim_name",offset,dtstr_id,hdf5err)
4602   if(hdf5err.lt.0) then
4603      Status =  WRF_HDF5_ERR_DATATYPE
4604      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4605      call wrf_debug ( WARN , msg)
4606      deallocate(length)
4607      deallocate(unlimited)
4608      return
4609   endif
4610
4611   call h5dread_f(dset_id,dt1_id,dim_name,data_dims,hdf5err)
4612   if(hdf5err.lt.0) then
4613      Status =  WRF_HDF5_ERR_DATASET_READ
4614      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4615      call wrf_debug ( WARN , msg)
4616      deallocate(length)
4617      deallocate(unlimited)
4618      return
4619   endif
4620
4621   ! the length of the dimension
4622   call h5tget_size_f(H5T_NATIVE_INTEGER,type_sizei,hdf5err)
4623   if(hdf5err.lt.0) then
4624      Status =  WRF_HDF5_ERR_DATATYPE
4625      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4626      call wrf_debug ( WARN , msg)
4627      deallocate(length)
4628      deallocate(unlimited)
4629      return
4630   endif
4631
4632   call h5tcreate_f(H5T_COMPOUND_F,type_sizei,dtint1_id,hdf5err)
4633   if(hdf5err.lt.0) then
4634      Status =  WRF_HDF5_ERR_DATATYPE
4635      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4636      call wrf_debug ( WARN , msg)
4637      deallocate(length)
4638      deallocate(unlimited)
4639      return
4640   endif
4641
4642   offset = 0
4643   call h5tinsert_f(dtint1_id,"dim_length",offset,H5T_NATIVE_INTEGER,hdf5err)
4644   if(hdf5err.lt.0) then
4645      Status =  WRF_HDF5_ERR_DATATYPE
4646      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4647      call wrf_debug ( WARN , msg)
4648      deallocate(length)
4649      deallocate(unlimited)
4650      return
4651   endif
4652
4653   call h5dread_f(dset_id,dtint1_id,length,data_dims,hdf5err)
4654   if(hdf5err.lt.0) then
4655      Status =  WRF_HDF5_ERR_DATASET_READ
4656      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4657      call wrf_debug ( WARN , msg)
4658      deallocate(length)
4659      deallocate(unlimited)
4660      return
4661   endif
4662
4663
4664   ! the unlimited info. of the dimension
4665   call h5tget_size_f(H5T_NATIVE_INTEGER,type_sizei,hdf5err)
4666   if(hdf5err.lt.0) then
4667      Status =  WRF_HDF5_ERR_DATATYPE
4668      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4669      call wrf_debug ( WARN , msg)
4670      deallocate(length)
4671      deallocate(unlimited)
4672      return
4673   endif
4674
4675   call h5tcreate_f(H5T_COMPOUND_F,type_sizei,dtint2_id,hdf5err)
4676   if(hdf5err.lt.0) then
4677      Status =  WRF_HDF5_ERR_DATATYPE
4678      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4679      call wrf_debug ( WARN , msg)
4680      deallocate(length)
4681      deallocate(unlimited)
4682      return
4683   endif
4684
4685   offset = 0
4686   call h5tinsert_f(dtint2_id,"dim_unlimited",offset,H5T_NATIVE_INTEGER,hdf5err)
4687   if(hdf5err.lt.0) then
4688      Status =  WRF_HDF5_ERR_DATATYPE
4689      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4690      call wrf_debug ( WARN , msg)
4691      deallocate(length)
4692      deallocate(unlimited)
4693      return
4694   endif
4695
4696   call h5dread_f(dset_id,dtint2_id,unlimited,data_dims,hdf5err)
4697   if(hdf5err.lt.0) then
4698      Status =  WRF_HDF5_ERR_DATASET_READ
4699      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4700      call wrf_debug ( WARN , msg)
4701      deallocate(length)
4702      deallocate(unlimited)
4703      return
4704   endif
4705
4706   ! Store the information to the table array
4707   do i =1,table_size
4708      DH%DIMTABLE(i)%dim_name = dim_name(i)
4709      DH%DIMTABLE(i)%length   = length(i)
4710      DH%DIMTABLE(i)%unlimited = unlimited(i)
4711   enddo
4712
4713   deallocate(length)
4714   deallocate(unlimited)
4715
4716   call h5tclose_f(dtint1_id,hdf5err)
4717   if(hdf5err.lt.0) then
4718      Status =  WRF_HDF5_ERR_CLOSE_GENERAL
4719      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4720      call wrf_debug ( WARN , msg)
4721      return
4722   endif
4723
4724   call h5tclose_f(dtstr_id,hdf5err)
4725   if(hdf5err.lt.0) then
4726      Status =  WRF_HDF5_ERR_CLOSE_GENERAL
4727      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4728      call wrf_debug ( WARN , msg)
4729      return
4730   endif
4731
4732   call h5tclose_f(dtint2_id,hdf5err)
4733   if(hdf5err.lt.0) then
4734      Status =  WRF_HDF5_ERR_CLOSE_GENERAL
4735      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4736      call wrf_debug ( WARN , msg)
4737      return
4738   endif
4739
4740   call h5tclose_f(dt1_id,hdf5err)
4741   if(hdf5err.lt.0) then
4742      Status =  WRF_HDF5_ERR_CLOSE_GENERAL
4743      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4744      call wrf_debug ( WARN , msg)
4745      return
4746   endif
4747
4748   call h5sclose_f(dataspace_id,hdf5err)
4749   if(hdf5err.lt.0) then
4750      Status =  WRF_HDF5_ERR_CLOSE_GENERAL
4751      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4752      call wrf_debug ( WARN , msg)
4753      return
4754   endif
4755
4756   call h5dclose_f(dset_id,hdf5err)
4757   if(hdf5err.lt.0) then
4758      Status =  WRF_HDF5_ERR_DATASET_CLOSE
4759      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4760      call wrf_debug ( WARN , msg)
4761      return
4762   endif
4763
4764   Status = WRF_NO_ERR
4765   return
4766 end subroutine retrieve_table
4767
4768 ! store(write) the dimensional table into the HDF5 file
4769 subroutine store_table(DataHandle,table_length,Status)
4770
4771   use wrf_phdf5_data
4772   use ext_phdf5_support_routines
4773   use hdf5
4774   implicit none
4775   include 'wrf_status_codes.h'
4776
4777   integer ,intent(in)                            :: DataHandle
4778   integer, intent(in)                            :: table_length
4779   integer, intent(out)                           :: Status
4780
4781   type(wrf_phdf5_data_handle),pointer             :: DH
4782
4783   integer(hid_t)                                 :: group_id
4784   integer(hid_t)                                 :: dset_id
4785   integer(hid_t)                                 :: dtype_id
4786   integer(hid_t)                                 :: dtstr_id
4787   integer(hid_t)                                 :: dtstrm_id
4788   integer(hid_t)                                 :: dtint1_id
4789   integer(hid_t)                                 :: dtint2_id
4790   integer(hid_t)                                 :: plist_id
4791   integer(size_t)                                :: type_size
4792   integer(size_t)                                :: type_sizes
4793   integer(size_t)                                :: type_sizei
4794   integer(size_t)                                :: offset
4795   character*256      ,dimension(MaxTabDims)       :: dim_name
4796   integer           ,dimension(:),allocatable    :: length
4797   integer           ,dimension(:),allocatable    :: unlimited
4798   integer(hid_t)                                 :: dspace_id
4799   integer(hsize_t)  ,dimension(1)                :: table_dims
4800   integer                                        :: table_rank
4801   integer(hsize_t) ,dimension(7)                 :: data_dims
4802   integer                                        :: i,j
4803   integer                                        :: hdf5err
4804
4805   data_dims(1) = table_length
4806   call GetDH(DataHandle,DH,Status)
4807   if(Status /= WRF_NO_ERR) then
4808      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__, &
4809           ', line', __LINE__
4810      call wrf_debug ( WARN , msg)
4811      return
4812   endif
4813
4814   call create_h5filetype(dtype_id,Status)
4815   if(Status /= WRF_NO_ERR) then
4816      return
4817   endif
4818
4819   ! obtain group id
4820   group_id = DH%DimGroupID
4821
4822   ! create data space
4823   table_rank    = 1
4824   table_dims(1) = table_length
4825
4826   call h5screate_simple_f(table_rank,table_dims,dspace_id,hdf5err)
4827   if(hdf5err.lt.0) then
4828      Status =  WRF_HDF5_ERR_DATASPACE
4829      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4830      call wrf_debug ( WARN , msg)
4831      return
4832   endif
4833
4834   ! obtain the data
4835   allocate(length(table_length))
4836   allocate(unlimited(table_length))
4837
4838   do i =1, table_length
4839      length(i)    = DH%DIMTABLE(i)%length
4840      unlimited(i) = DH%DIMTABLE(i)%unlimited
4841   enddo
4842
4843   do i=1,table_length
4844      do j=1,256
4845         dim_name(i)(j:j)=DH%DIMTABLE(i)%dim_name(j:j)
4846      enddo
4847   enddo
4848
4849   ! under dimensional group
4850   call h5dcreate_f(group_id,"h5dim_table",dtype_id,dspace_id,&
4851        dset_id,hdf5err)
4852   if(hdf5err.lt.0) then
4853      Status =  WRF_HDF5_ERR_DATASET_CREATE
4854      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4855      call wrf_debug ( WARN , msg)
4856      deallocate(length)
4857      deallocate(unlimited)
4858      return
4859   endif
4860
4861   ! create memory types
4862   call h5tget_size_f(H5T_NATIVE_INTEGER,type_sizei,hdf5err)
4863   if(hdf5err.lt.0) then
4864      Status =  WRF_HDF5_ERR_DATATYPE
4865      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4866      call wrf_debug ( WARN , msg)
4867      deallocate(length)
4868      deallocate(unlimited)
4869      return
4870   endif
4871
4872   ! FOR string, it needs extra handling
4873   call h5tcopy_f(H5T_NATIVE_CHARACTER,dtstr_id,hdf5err)
4874   if(hdf5err.lt.0) then
4875      Status =  WRF_HDF5_ERR_DATATYPE
4876      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4877      call wrf_debug ( WARN , msg)
4878      deallocate(length)
4879      deallocate(unlimited)
4880      return
4881   endif
4882
4883   type_size = 256
4884
4885      call h5tset_size_f(dtstr_id, type_size,hdf5err)
4886      if(hdf5err.lt.0) then
4887         Status =  WRF_HDF5_ERR_DATATYPE
4888         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4889         call wrf_debug ( WARN , msg)
4890         deallocate(length)
4891         deallocate(unlimited)
4892         return
4893      endif
4894
4895      call h5tget_size_f(dtstr_id, type_size,hdf5err)
4896      if(hdf5err.lt.0) then
4897         Status =  WRF_HDF5_ERR_DATATYPE
4898         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4899         call wrf_debug ( WARN , msg)
4900         deallocate(length)
4901         deallocate(unlimited)
4902         return
4903      endif
4904
4905      call h5tcreate_f(H5T_COMPOUND_F,type_size,dtstrm_id,hdf5err)
4906      if(hdf5err.lt.0) then
4907         Status =  WRF_HDF5_ERR_DATATYPE
4908         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4909         call wrf_debug ( WARN , msg)
4910         deallocate(length)
4911         deallocate(unlimited)
4912         return
4913      endif
4914
4915      offset = 0
4916      call h5tinsert_f(dtstrm_id,"dim_name",offset,dtstr_id,hdf5err)
4917      if(hdf5err.lt.0) then
4918         Status =  WRF_HDF5_ERR_DATATYPE
4919         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4920         call wrf_debug ( WARN , msg)
4921         deallocate(length)
4922         deallocate(unlimited)
4923         return
4924      endif
4925
4926      call h5tcreate_f(H5T_COMPOUND_F,type_sizei,dtint1_id,hdf5err)
4927      if(hdf5err.lt.0) then
4928         Status =  WRF_HDF5_ERR_DATATYPE
4929         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4930         call wrf_debug ( WARN , msg)
4931         deallocate(length)
4932         deallocate(unlimited)
4933         return
4934      endif
4935
4936      offset = 0
4937      call h5tinsert_f(dtint1_id,"dim_length",offset,H5T_NATIVE_INTEGER,&
4938           hdf5err)
4939      if(hdf5err.lt.0) then
4940         Status =  WRF_HDF5_ERR_DATATYPE
4941         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4942         call wrf_debug ( WARN , msg)
4943         deallocate(length)
4944         deallocate(unlimited)
4945         return
4946      endif
4947
4948      call h5tcreate_f(H5T_COMPOUND_F,type_sizei,dtint2_id,hdf5err)
4949      if(hdf5err.lt.0) then
4950         Status =  WRF_HDF5_ERR_DATATYPE
4951         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4952         call wrf_debug ( WARN , msg)
4953         deallocate(length)
4954         deallocate(unlimited)
4955         return
4956      endif
4957
4958      offset = 0
4959      call h5tinsert_f(dtint2_id,"dim_unlimited",offset,H5T_NATIVE_INTEGER,&
4960           hdf5err)
4961      if(hdf5err.lt.0) then
4962         Status =  WRF_HDF5_ERR_DATATYPE
4963         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4964         call wrf_debug ( WARN , msg)
4965         deallocate(length)
4966         deallocate(unlimited)
4967         return
4968      endif
4969
4970      ! write data by fields in the datatype,but first create a property list
4971
4972      call h5pcreate_f(H5P_DATASET_XFER_F,plist_id, hdf5err)
4973      if(hdf5err.lt.0) then
4974         Status =  WRF_HDF5_ERR_PROPERTY_LIST
4975         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4976         call wrf_debug ( WARN , msg)
4977         deallocate(length)
4978         deallocate(unlimited)
4979         return
4980      endif
4981
4982      call h5pset_preserve_f(plist_id,.TRUE.,hdf5err)
4983      if(hdf5err.lt.0) then
4984         Status =  WRF_HDF5_ERR_PROPERTY_LIST
4985         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4986         call wrf_debug ( WARN , msg)
4987         deallocate(length)
4988         deallocate(unlimited)
4989         return
4990      endif
4991
4992      call h5dwrite_f(dset_id,dtstrm_id,dim_name,data_dims,hdf5err,&
4993           xfer_prp = plist_id)
4994      if(hdf5err.lt.0) then
4995         Status =  WRF_HDF5_ERR_DATASET_WRITE
4996         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
4997         call wrf_debug ( WARN , msg)
4998         deallocate(length)
4999         deallocate(unlimited)
5000         return
5001      endif
5002
5003      call h5dwrite_f(dset_id,dtint1_id,length,data_dims,hdf5err,&
5004           xfer_prp = plist_id)
5005      if(hdf5err.lt.0) then
5006         Status =  WRF_HDF5_ERR_DATASET_WRITE
5007         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
5008         call wrf_debug ( WARN , msg)
5009         deallocate(length)
5010         deallocate(unlimited)
5011         return
5012      endif
5013
5014      call h5dwrite_f(dset_id,dtint2_id,unlimited,data_dims,hdf5err,&
5015           xfer_prp = plist_id)
5016      if(hdf5err.lt.0) then
5017         Status =  WRF_HDF5_ERR_DATASET_WRITE
5018         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
5019         call wrf_debug ( WARN , msg)
5020         deallocate(length)
5021         deallocate(unlimited)
5022         return
5023      endif
5024
5025      deallocate(length)
5026      deallocate(unlimited)
5027
5028      ! release resources
5029
5030      call h5tclose_f(dtstr_id,hdf5err)
5031      if(hdf5err.lt.0) then
5032         Status =  WRF_HDF5_ERR_CLOSE_GENERAL
5033         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
5034         call wrf_debug ( WARN , msg)
5035         return
5036      endif
5037
5038      call h5tclose_f(dtstrm_id,hdf5err)
5039      if(hdf5err.lt.0) then
5040         Status =  WRF_HDF5_ERR_CLOSE_GENERAL
5041         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
5042         call wrf_debug ( WARN , msg)
5043         return
5044      endif
5045
5046      call h5tclose_f(dtint1_id,hdf5err)
5047      if(hdf5err.lt.0) then
5048         Status =  WRF_HDF5_ERR_CLOSE_GENERAL
5049         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
5050         call wrf_debug ( WARN , msg)
5051         return
5052      endif
5053
5054      call h5tclose_f(dtint2_id,hdf5err)
5055      if(hdf5err.lt.0) then
5056         Status =  WRF_HDF5_ERR_CLOSE_GENERAL
5057         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
5058         call wrf_debug ( WARN , msg)
5059         return
5060      endif
5061
5062      call h5tclose_f(dtype_id,hdf5err)
5063      if(hdf5err.lt.0) then
5064         Status =  WRF_HDF5_ERR_CLOSE_GENERAL
5065         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
5066         call wrf_debug ( WARN , msg)
5067         return
5068      endif
5069
5070      call h5pclose_f(plist_id,hdf5err)
5071      if(hdf5err.lt.0) then
5072         Status =  WRF_HDF5_ERR_CLOSE_GENERAL
5073         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
5074         call wrf_debug ( WARN , msg)
5075         return
5076      endif
5077
5078      call h5dclose_f(dset_id,hdf5err)
5079      if(hdf5err.lt.0) then
5080         Status =  WRF_HDF5_ERR_DATASET_CLOSE
5081         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
5082         call wrf_debug ( WARN , msg)
5083         return
5084      endif
5085
5086      call h5sclose_f(dspace_id,hdf5err)
5087      if(hdf5err.lt.0) then
5088         Status =  WRF_HDF5_ERR_CLOSE_GENERAL
5089         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
5090         call wrf_debug ( WARN , msg)
5091         return
5092      endif
5093
5094      return
5095 end subroutine store_table
5096
5097
5098 subroutine free_memory(DataHandle,Status)
5099
5100   use wrf_phdf5_data
5101   use ext_phdf5_support_routines
5102   use HDF5
5103   implicit none
5104   include 'wrf_status_codes.h'
5105   include 'mpif.h'
5106
5107   integer              ,intent(in)       :: DataHandle
5108   integer              ,intent(out)      :: Status
5109   integer                                :: hdf5err
5110   type(wrf_phdf5_data_handle),pointer    :: DH
5111   integer                                :: i
5112   integer                                :: stat
5113   real*8                                 :: timeaw,timebw
5114
5115
5116   call GetDH(DataHandle,DH,Status)
5117   if(Status /= WRF_NO_ERR) then
5118      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
5119      call wrf_debug ( WARN , msg)
5120      return
5121   endif
5122
5123   if(DH%Free) then
5124      Status = WRF_HDF5_ERR_OTHERS
5125      write(msg,*) '',__FILE__,', line', __LINE__
5126      call wrf_debug ( WARN , msg)
5127      return
5128   endif
5129
5130   deallocate(DH%Times, STAT=stat)
5131   if(stat/= 0) then
5132      Status = WRF_HDF5_ERR_DEALLOCATION
5133      write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
5134      call wrf_debug ( FATAL , msg)
5135      return
5136   endif
5137   deallocate(DH%DimLengths, STAT=stat)
5138   if(stat/= 0) then
5139      Status = WRF_HDF5_ERR_DEALLOCATION
5140      write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
5141      call wrf_debug ( FATAL , msg)
5142      return
5143   endif
5144   deallocate(DH%DimIDs, STAT=stat)
5145   if(stat/= 0) then
5146      Status = WRF_HDF5_ERR_DEALLOCATION
5147      write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
5148      call wrf_debug ( FATAL , msg)
5149      return
5150   endif
5151   deallocate(DH%DimNames, STAT=stat)
5152   if(stat/= 0) then
5153      Status = WRF_HDF5_ERR_DEALLOCATION
5154      write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
5155      call wrf_debug ( FATAL , msg)
5156      return
5157   endif
5158   deallocate(DH%DIMTABLE, STAT=stat)
5159   if(stat/= 0) then
5160      Status = WRF_HDF5_ERR_DEALLOCATION
5161      write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
5162      call wrf_debug ( FATAL , msg)
5163      return
5164   endif
5165   deallocate(DH%MDDsetIDs, STAT=stat)
5166   if(stat/= 0) then
5167      Status = WRF_HDF5_ERR_DEALLOCATION
5168      write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
5169      call wrf_debug ( FATAL , msg)
5170      return
5171   endif
5172   deallocate(DH%MDVarDimLens, STAT=stat)
5173   if(stat/= 0) then
5174      Status = WRF_HDF5_ERR_DEALLOCATION
5175      write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
5176      call wrf_debug ( FATAL , msg)
5177      return
5178   endif
5179   deallocate(DH%MDVarNames, STAT=stat)
5180   if(stat/= 0) then
5181      Status = WRF_HDF5_ERR_DEALLOCATION
5182      write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
5183      call wrf_debug ( FATAL , msg)
5184      return
5185   endif
5186   deallocate(DH%DsetIDs, STAT=stat)
5187   if(stat/= 0) then
5188      Status = WRF_HDF5_ERR_DEALLOCATION
5189      write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
5190      call wrf_debug ( FATAL , msg)
5191      return
5192   endif
5193   deallocate(DH%VarDimLens, STAT=stat)
5194   if(stat/= 0) then
5195      Status = WRF_HDF5_ERR_DEALLOCATION
5196      write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
5197      call wrf_debug ( FATAL , msg)
5198      return
5199   endif
5200   deallocate(DH%VarNames, STAT=stat)
5201   if(stat/= 0) then
5202      Status = WRF_HDF5_ERR_DEALLOCATION
5203      write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
5204      call wrf_debug ( FATAL , msg)
5205      return
5206   endif
5207   return
5208 end subroutine free_memory
5209
5210 subroutine write_hdf5_attributes(DataHandle,MemoryOrder,WrfDType,DimRank,&
5211      NDim,dset_id,Status)
5212
5213   use wrf_phdf5_data
5214   use ext_phdf5_support_routines
5215   use HDF5
5216   implicit none
5217   include 'mpif.h'
5218   include 'wrf_status_codes.h'
5219
5220
5221   integer                     ,intent(in)     :: DataHandle
5222   character*(*)               ,intent(in)     :: MemoryOrder
5223   integer                     ,intent(in)     :: WrfDType
5224   integer,dimension(*)        ,intent(in)     :: DimRank
5225
5226   integer                     ,intent(in)     :: NDim
5227
5228   integer(hid_t)              ,intent(in)     :: dset_id
5229   integer                     ,intent(out)    :: Status
5230
5231   character (3)                               :: Mem0
5232   character (3)                               :: UCMem0
5233   type(wrf_phdf5_data_handle) ,pointer        :: DH
5234
5235   ! attribute defination
5236   integer(hid_t)                              :: dimaspace_id  ! DimRank dataspace id
5237   integer(hid_t)                              :: dimattr_id    ! DimRank attribute id
5238   integer(hsize_t) ,dimension(1)              :: dim_space
5239
5240   integer(hid_t)                              :: h5_atypeid    ! for fieldtype,memorder attribute
5241   integer(hid_t)                              :: h5_aspaceid   ! for fieldtype,memorder
5242   integer(hid_t)                              :: h5_attrid     ! for fieldtype,memorder
5243   integer(hsize_t), dimension(7)              :: adata_dims
5244   integer                                     :: routine_atype
5245   integer,          dimension(:),allocatable  :: dimrank_data
5246   integer                                     :: hdf5err
5247   integer                                     :: j
5248
5249   !  For time function
5250   real*8                                     :: timebw
5251   real*8                                     :: timeaw
5252   integer                                    :: total_ele
5253
5254   !
5255   ! write dimensional rank attribute. This is the temporary fix for dim. scale
5256   ! the first dimension is always time
5257   allocate(dimrank_data(NDim+1))
5258   do j =1, NDim+1
5259      dimrank_data(j)  = DimRank(j)
5260   enddo
5261
5262   dim_space(1)  = NDim+1
5263   adata_dims(1) = NDim+1
5264   call h5screate_simple_f(1,dim_space,dimaspace_id,hdf5err)
5265   if(hdf5err.lt.0) then
5266      Status =  WRF_HDF5_ERR_DATASPACE
5267      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
5268      call wrf_debug ( WARN , msg)
5269      deallocate(dimrank_data)
5270      return
5271   endif
5272
5273   call h5acreate_f(dset_id,'H5_DimRank',H5T_NATIVE_INTEGER,dimaspace_id, &
5274        dimattr_id,hdf5err)
5275   if(hdf5err.lt.0) then
5276      Status =  WRF_HDF5_ERR_ATTRIBUTE_CREATE
5277      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
5278      call wrf_debug ( WARN , msg)
5279      deallocate(dimrank_data)
5280      return
5281   endif
5282
5283   call h5awrite_f(dimattr_id,H5T_NATIVE_INTEGER,dimrank_data,adata_dims,hdf5err)
5284   if(hdf5err.lt.0) then
5285      Status =  WRF_HDF5_ERR_ATTRIBUTE_WRITE
5286      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
5287      call wrf_debug ( WARN , msg)
5288      deallocate(dimrank_data)
5289      return
5290   endif
5291   deallocate(dimrank_data)
5292
5293   ! close space and attribute id
5294   call clean_phdf5_attrids(H5T_NATIVE_INTEGER,dimaspace_id,dimattr_id,0,Status)
5295   if(Status.ne.WRF_NO_ERR) then
5296      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
5297      call wrf_debug ( WARN , msg)
5298      return
5299   endif
5300   ! Write memory order and FieldType attribute, both MemoryOrder and FieldType are 1 element
5301   adata_dims(1) = 1
5302
5303   ! output memoryorder attribute
5304   call reorder(MemoryOrder,Mem0)
5305   call uppercase(Mem0,UCMem0)
5306
5307   routine_atype = WRF_CHARACTER
5308
5309   ! The size of memoryorder string is always MemOrdLen
5310   call create_phdf5_adtypeid(h5_atypeid,routine_atype,MemOrdLen,Status)
5311   if(Status.ne.WRF_NO_ERR) then
5312      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
5313      call wrf_debug ( WARN , msg)
5314      return
5315   endif
5316
5317   ! Count for string attribute is always 1
5318   call create_phdf5_adspaceid(1,1,h5_aspaceid,Status)
5319   if(Status.ne.WRF_NO_ERR) then
5320      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
5321      call wrf_debug ( WARN , msg)
5322      return
5323   endif
5324   call h5acreate_f(dset_id,'MemoryOrder',h5_atypeid,h5_aspaceid, &
5325        h5_attrid, hdf5err)
5326   if(hdf5err.lt.0) then
5327      Status =  WRF_HDF5_ERR_ATTRIBUTE_CREATE
5328      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
5329      call wrf_debug ( WARN , msg)
5330      return
5331   endif
5332
5333   call h5awrite_f(h5_attrid,h5_atypeid,UCMem0,adata_dims,hdf5err)
5334   if(hdf5err.lt.0) then
5335      Status =  WRF_HDF5_ERR_ATTRIBUTE_WRITE
5336      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
5337      call wrf_debug ( WARN , msg)
5338      return
5339   endif
5340   call clean_phdf5_attrids(h5_atypeid,h5_aspaceid,h5_attrid,1,Status)
5341   if(Status.ne.WRF_NO_ERR) then
5342      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
5343      call wrf_debug ( WARN , msg)
5344      return
5345   endif
5346
5347   ! output fieldtype attribute
5348   call create_phdf5_adspaceid(1,1,h5_aspaceid,Status)
5349   if(Status.ne.WRF_NO_ERR) then
5350      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
5351      call wrf_debug ( WARN , msg)
5352      return
5353   endif
5354
5355   call h5acreate_f(dset_id,'FieldType',H5T_NATIVE_INTEGER,h5_aspaceid, &
5356        h5_attrid, hdf5err)
5357   if(hdf5err.lt.0) then
5358      Status =  WRF_HDF5_ERR_ATTRIBUTE_CREATE
5359      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
5360      call wrf_debug ( WARN , msg)
5361      return
5362   endif
5363
5364   call h5awrite_f(h5_attrid,H5T_NATIVE_INTEGER,WrfDType,adata_dims,hdf5err)
5365   if(hdf5err.lt.0) then
5366      Status =  WRF_HDF5_ERR_ATTRIBUTE_WRITE
5367      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
5368      call wrf_debug ( WARN , msg)
5369      return
5370   endif
5371   call clean_phdf5_attrids(H5T_NATIVE_INTEGER,h5_aspaceid,h5_attrid,0,Status)
5372   if(Status.ne.WRF_NO_ERR) then
5373      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
5374      call wrf_debug ( WARN , msg)
5375      return
5376   endif
5377
5378 end subroutine write_hdf5_attributes