external/io_phdf5/wrf-phdf5attr.F90btg

   1 !/****************************************************************************
   2 !* NCSA HDF                                                                 *
   3 !*     *
   4 !* National Center for Supercomputing Applications                          *
   5 !* University of Illinois at Urbana-Champaign                               *
   6 !* 605 E. Springfield, Champaign IL 61820                                   *
   7 !*                                                                          *
   8 !* For conditions of distribution and use, see the accompanying             *
   9 !* hdf/COPYING file.                                                        *
  10 !*                                                                          *
  11 !****************************************************************************/
  12
  13 module get_attrid_routine
  14
  15 Interface get_attrid
  16  module  procedure get_attrid
  17 end interface
  18
  19  contains
  20
  21 subroutine get_attrid(DataHandle,Element,h5_attrid,Status,VAR)
  22
  23   use wrf_phdf5_data
  24   use ext_phdf5_support_routines
  25   USE HDF5 ! This module contains all necessary modules
  26   implicit none
  27   include 'wrf_status_codes.h'
  28
  29   character*(*)         ,intent(in)             :: Element
  30   integer               ,intent(in)             :: DataHandle
  31   integer(hid_t)        ,intent(out)            :: h5_attrid
  32   integer(hid_t)                                :: dset_id
  33   integer               ,intent(out)            :: Status
  34   character*(*)         ,intent(in),optional    :: VAR
  35   integer(hid_t)                                :: hdf5err
  36   type(wrf_phdf5_data_handle),pointer           :: DH
  37
  38   character(Len = MaxTimeSLen)                  :: tname
  39   character(Len = 256)                          :: tgroupname
  40   integer(hid_t)                                :: tgroup_id
  41
  42   call GetDH(DataHandle,DH,Status)
  43   if(Status /= WRF_NO_ERR) then
  44      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
  45      call wrf_debug ( WARN , msg)
  46      return
  47   endif
  48
  49   if(present(VAR)) then
  50       call numtochar(1,tname)
  51       tgroupname = 'TIME_STAMP_'//tname
  52       call h5gopen_f(DH%GroupID,tgroupname,tgroup_id,hdf5err)
  53       call h5dopen_f(tgroup_id,VAR,dset_id,hdf5err)
  54       if(hdf5err.lt.0) then
  55         Status =  WRF_HDF5_ERR_DATASET_OPEN
  56         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
  57         call wrf_debug ( WARN , msg)
  58         return
  59       endif
  60
  61       call h5aopen_name_f(dset_id,Element,h5_attrid,hdf5err)
  62       if(hdf5err.lt.0) then
  63         Status =  WRF_HDF5_ERR_ATTRIBUTE_OPEN
  64         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
  65         call wrf_debug ( WARN , msg)
  66         return
  67       endif
  68       call h5dclose_f(dset_id,hdf5err)
  69       call h5gclose_f(tgroup_id,hdf5err)
  70   else
  71      call h5aopen_name_f(DH%GroupID,Element,h5_attrid,hdf5err)
  72      if(hdf5err.lt.0) then
  73         Status =  WRF_HDF5_ERR_ATTRIBUTE_OPEN
  74         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
  75         call wrf_debug ( WARN , msg)
  76         return
  77       endif
  78   endif
  79   return
  80  end subroutine get_attrid
  81 end module get_attrid_routine
  82
  83 subroutine create_phdf5_objid(DataHandle,obj_id,routine_type,var,Status)
  84
  85   use wrf_phdf5_data
  86   use ext_phdf5_support_routines
  87   use HDF5
  88   implicit none
  89   include 'wrf_status_codes.h'
  90
  91   integer                                      :: i
  92   integer                       ,intent(in)    :: DataHandle
  93   integer(hid_t)                ,intent(out)   :: obj_id
  94   character*3                   ,intent(in)    :: routine_type
  95   character*(*)                 ,intent(in)    :: var
  96   integer                       ,intent(out)   :: Status
  97   integer(hid_t)                               :: hdf5err
  98   type(wrf_phdf5_data_handle),pointer           :: DH
  99
 100
 101   call GetDH(DataHandle,DH,Status)
 102   if(Status /= WRF_NO_ERR) then
 103      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,' ',ROUTINE_TYPE,', line', __LINE__
 104      call wrf_debug ( WARN , msg)
 105      return
 106   endif
 107
 108   if(routine_type == 'DOM') then
 109
 110      if(DH%FileStatus == WRF_FILE_OPENED_AND_COMMITTED) then
 111         obj_id = DH%GroupID
 112      endif
 113
 114   else if(routine_type == 'VAR') then
 115
 116      if(DH%FileStatus == WRF_FILE_OPENED_AND_COMMITTED) then
 117         do i = 1, MaxVars
 118            if(DH%VarNames(i) == var) then
 119               obj_id = DH%dsetids(i)
 120                 write(*,*) "obj_id at attribute",obj_id
 121                 write(*,*) "DH%VarNames(i)",DH%VarNames(i)
 122               exit
 123            endif
 124         enddo
 125      endif
 126
 127   else
 128      Status = WRF_HDF5_ERR_DATA_ID_NOTFOUND
 129      write(msg,*) 'CANNOT FIND DATASET ID of the attribute in',__FILE__,&
 130      ', line',__LINE__
 131   endif
 132
 133   return
 134 end subroutine create_phdf5_objid
 135
 136
 137 subroutine create_phdf5_adtypeid(h5_atypeid,routine_datatype,Count,Status,DataHandle)
 138
 139   use wrf_phdf5_data
 140   use ext_phdf5_support_routines
 141   use HDF5
 142   implicit none
 143   include 'wrf_status_codes.h'
 144
 145   integer                                      :: i
 146   integer(hid_t)                ,intent(out)   :: h5_atypeid
 147   integer                       ,intent(in)    :: routine_datatype
 148   integer                       ,intent(in)    :: Count
 149   integer                       ,intent(out)   :: Status
 150   integer(hid_t)                               :: hdf5err
 151   integer, intent(in), optional                :: DataHandle
 152   integer(size_t)                              :: count_size
 153
 154   type(wrf_phdf5_data_handle),pointer           :: DH
 155
 156   if(routine_datatype == WRF_LOGICAL)then
 157      call GetDH(DataHandle,DH,Status)
 158      if(Status /= WRF_NO_ERR) then
 159         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 160         call wrf_debug ( WARN , msg)
 161         return
 162      endif
 163
 164   endif
 165
 166   select case(routine_datatype)
 167   case (WRF_REAL)
 168      h5_atypeid = H5T_NATIVE_REAL
 169   case (WRF_DOUBLE)
 170      h5_atypeid = H5T_NATIVE_DOUBLE
 171   case (WRF_INTEGER)
 172      h5_atypeid = H5T_NATIVE_INTEGER
 173   case (WRF_LOGICAL)
 174      h5_atypeid = DH%EnumID
 175   case (WRF_CHARACTER)
 176
 177      call h5tcopy_f(H5T_NATIVE_CHARACTER,h5_atypeid,hdf5err)
 178      if(hdf5err.lt.0) then
 179        Status =  WRF_HDF5_ERR_DATATYPE
 180        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 181        call wrf_debug ( WARN , msg)
 182        return
 183     endif
 184
 185      count_size = count
 186      call h5tset_size_f(h5_atypeid,count_size,hdf5err)
 187      if(hdf5err.lt.0) then
 188        Status =  WRF_HDF5_ERR_DATATYPE
 189        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 190        call wrf_debug ( WARN , msg)
 191        return
 192     endif
 193
 194      call h5tset_strpad_f(h5_atypeid,H5T_STR_SPACEPAD_F,hdf5err)
 195      if(hdf5err.lt.0) then
 196        Status =  WRF_HDF5_ERR_DATATYPE
 197        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 198        call wrf_debug ( WARN , msg)
 199        return
 200     endif
 201
 202   case default
 203      Status = WRF_HDF5_ERR_DATATYPE
 204      return
 205   end select
 206
 207   Status = WRF_NO_ERR
 208
 209   return
 210 end subroutine create_phdf5_adtypeid
 211
 212 subroutine create_phdf5_adspaceid(Count,str_flag,h5_aspaceid,Status)
 213
 214   use wrf_phdf5_data
 215   use HDF5
 216   implicit none
 217   include 'wrf_status_codes.h'
 218
 219   integer                                      :: i
 220   integer                       ,intent(in)    :: Count
 221   integer                       ,intent(in)    :: str_flag
 222   integer                       ,intent(out)   :: Status
 223
 224   integer(hsize_t)              , dimension(1) :: adims
 225   integer(hid_t)                               :: hdf5err
 226   integer(hid_t)                ,intent(out)   :: h5_aspaceid
 227   integer                                      :: arank = 1
 228
 229   ! if string, count is always 1
 230   if(str_flag == 1) then
 231      adims(1) = 1
 232      call h5screate_simple_f(arank,adims,h5_aspaceid,hdf5err)
 233      if(hdf5err.lt.0) then
 234        Status =  WRF_HDF5_ERR_DATASPACE
 235        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 236        call wrf_debug ( WARN , msg)
 237        return
 238      endif
 239
 240   else
 241      adims(1) = Count
 242      call h5screate_simple_f(arank,adims,h5_aspaceid,hdf5err)
 243      if(hdf5err.lt.0) then
 244        Status =  WRF_HDF5_ERR_DATASPACE
 245        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 246        call wrf_debug ( WARN , msg)
 247        return
 248      endif
 249
 250   endif
 251
 252   Status = WRF_NO_ERR
 253
 254   return
 255 end subroutine create_phdf5_adspaceid
 256
 257
 258 subroutine clean_phdf5_attrids(h5_attr_typeid,h5_space_typeid, &
 259      h5_attrid,str_flag,Status)
 260
 261   use wrf_phdf5_data
 262   use HDF5
 263   implicit none
 264   include 'wrf_status_codes.h'
 265   integer                       ,intent(out)   :: Status
 266   integer(hid_t)                ,intent(in)    :: h5_attr_typeid
 267   integer(hid_t)                ,intent(in)    :: h5_space_typeid
 268   integer(hid_t)                ,intent(in)    :: h5_attrid
 269   integer                       ,intent(in)    :: str_flag
 270   integer                                      :: hdf5err
 271
 272   if(str_flag == 1) then
 273      call h5tclose_f(h5_attr_typeid,hdf5err)
 274      if(hdf5err.lt.0) then
 275        Status =  WRF_HDF5_ERR_CLOSE_GENERAL
 276        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 277        call wrf_debug ( WARN , msg)
 278        return
 279     endif
 280   endif
 281
 282   call h5sclose_f(h5_space_typeid,hdf5err)
 283   if(hdf5err.lt.0) then
 284        Status =  WRF_HDF5_ERR_CLOSE_GENERAL
 285        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 286        call wrf_debug ( WARN , msg)
 287        return
 288   endif
 289   call h5aclose_f(h5_attrid,hdf5err)
 290   if(hdf5err.lt.0) then
 291        Status =  WRF_HDF5_ERR_ATTRIBUTE_CLOSE
 292        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 293        call wrf_debug ( WARN , msg)
 294        return
 295   endif
 296
 297   Status = WRF_NO_ERR
 298
 299   return
 300
 301 end subroutine clean_phdf5_attrids
 302
 303
 304 subroutine create_h5filetype(dtype_id,Status)
 305
 306   use wrf_phdf5_data
 307   use ext_phdf5_support_routines
 308   use hdf5
 309   implicit none
 310   include 'wrf_status_codes.h'
 311
 312   integer(hid_t),intent(out)              :: dtype_id
 313   integer(hid_t)                         :: dtstr_id
 314   integer(size_t)                        :: type_size
 315   integer(size_t)                        :: type_sizes
 316   integer(size_t)                        :: type_sizei
 317   integer(size_t)                        :: offset
 318   integer,     intent(out)               :: Status
 319   integer(hid_t)                         :: hdf5err
 320
 321   call h5tcopy_f(H5T_NATIVE_CHARACTER,dtstr_id,hdf5err)
 322   if(hdf5err.lt.0) then
 323        Status =  WRF_HDF5_ERR_DATATYPE
 324        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 325        call wrf_debug ( WARN , msg)
 326        return
 327    endif
 328
 329   type_size = 80
 330   call h5tset_size_f(dtstr_id,type_size,hdf5err)
 331   if(hdf5err.lt.0) then
 332        Status =  WRF_HDF5_ERR_DATATYPE
 333        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 334        call wrf_debug ( WARN , msg)
 335        return
 336   endif
 337
 338   call h5tget_size_f(dtstr_id,type_sizes,hdf5err)
 339   if(hdf5err.lt.0) then
 340        Status =  WRF_HDF5_ERR_DATATYPE
 341        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 342        call wrf_debug ( WARN , msg)
 343        return
 344   endif
 345
 346   call h5tget_size_f(H5T_NATIVE_INTEGER,type_sizei,hdf5err)
 347   if(hdf5err.lt.0) then
 348        Status =  WRF_HDF5_ERR_DATATYPE
 349        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 350        call wrf_debug ( WARN , msg)
 351        return
 352   endif
 353
 354   type_size = type_sizes + 2*type_sizei
 355   call h5tcreate_f(H5T_COMPOUND_F,type_size,dtype_id,hdf5err)
 356   if(hdf5err.lt.0) then
 357        Status =  WRF_HDF5_ERR_DATATYPE
 358        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 359        call wrf_debug ( WARN , msg)
 360        return
 361   endif
 362
 363
 364   offset = 0
 365   call h5tinsert_f(dtype_id,"dim_name",offset,dtstr_id,hdf5err)
 366   if(hdf5err.lt.0) then
 367        Status =  WRF_HDF5_ERR_DATATYPE
 368        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 369        call wrf_debug ( WARN , msg)
 370        return
 371    endif
 372
 373   offset = offset + type_sizes
 374   call h5tinsert_f(dtype_id,"dim_length",offset,H5T_NATIVE_INTEGER,&
 375        hdf5err)
 376   if(hdf5err.lt.0) then
 377        Status =  WRF_HDF5_ERR_DATATYPE
 378        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 379        call wrf_debug ( WARN , msg)
 380        return
 381     endif
 382
 383   offset = offset + type_sizei
 384
 385   call h5tinsert_f(dtype_id,"dim_unlimited",offset,H5T_NATIVE_INTEGER,&
 386        hdf5err)
 387   if(hdf5err.lt.0) then
 388        Status =  WRF_HDF5_ERR_DATATYPE
 389        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 390        call wrf_debug ( WARN , msg)
 391        return
 392     endif
 393
 394
 395   call h5tclose_f(dtstr_id,hdf5err)
 396   if(hdf5err.lt.0) then
 397        Status =  WRF_HDF5_ERR_CLOSE_GENERAL
 398        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 399        call wrf_debug ( WARN , msg)
 400        return
 401     endif
 402
 403   Status = WRF_NO_ERR
 404   return
 405 end subroutine  create_h5filetype
 406
 407 ! check whether two types are equal, attr_type and h5_attrid
 408 subroutine check_type(DataHandle,attr_type,h5_attrid,Status)
 409
 410   use wrf_phdf5_data
 411   use ext_phdf5_support_routines
 412   USE HDF5 ! This module contains all necessary modules
 413   implicit none
 414   include 'wrf_status_codes.h'
 415
 416    integer               ,intent(in)     :: DataHandle
 417    integer(hid_t)        ,intent(in)     :: attr_type
 418    integer(hid_t)       ,intent(in)      :: h5_attrid
 419    integer               ,intent(out)    :: Status
 420    integer(hid_t)                        :: h5_atypeid
 421    integer(hid_t)                        :: h5_classid
 422    integer(hid_t)                        :: h5_wrfclassid
 423    logical                               :: flag
 424    integer                               :: hdf5err
 425    type(wrf_phdf5_data_handle),pointer    :: DH
 426
 427   call GetDH(DataHandle,DH,Status)
 428   if(Status /= WRF_NO_ERR) then
 429      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 430      call wrf_debug ( WARN , msg)
 431      return
 432   endif
 433
 434   call h5aget_type_f(h5_attrid,h5_atypeid,hdf5err)
 435   if(hdf5err.lt.0) then
 436        Status =  WRF_HDF5_ERR_DATATYPE
 437        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 438        call wrf_debug ( WARN , msg)
 439        return
 440   endif
 441
 442   call h5tget_class_f(h5_atypeid,h5_classid,hdf5err)
 443   if(hdf5err.lt.0) then
 444        Status =  WRF_HDF5_ERR_DATATYPE
 445        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 446        call wrf_debug ( WARN , msg)
 447        return
 448   endif
 449
 450   call h5tget_class_f(attr_type,h5_wrfclassid,hdf5err)
 451   if(hdf5err.lt.0) then
 452        Status =  WRF_HDF5_ERR_DATATYPE
 453        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 454        call wrf_debug ( WARN , msg)
 455        return
 456   endif
 457
 458   if((h5_classid==H5T_STRING_F).AND.&
 459       (attr_type==H5T_NATIVE_CHARACTER)) then
 460      flag = .TRUE.
 461   else
 462      if(h5_classid .NE. h5_wrfclassid) then
 463         flag = .FALSE.
 464      else
 465         flag = .TRUE.
 466      endif
 467   endif
 468
 469   if(flag .EQV. .FALSE.) then
 470      Status = WRF_HDF5_ERR_TYPE_MISMATCH
 471      return
 472   endif
 473
 474   Status = WRF_NO_ERR
 475   return
 476 end subroutine check_type
 477
 478
 479 subroutine retrieve_ti_info(DataHandle,h5_attrid,h5_atypeid,Count,OutCount,Status)
 480
 481   use wrf_phdf5_data
 482   use ext_phdf5_support_routines
 483   USE HDF5 ! This module contains all necessary modules
 484   implicit none
 485   include 'wrf_status_codes.h'
 486
 487   integer               ,intent(in)     :: DataHandle
 488   integer               ,intent(in)     :: h5_attrid
 489   integer(hid_t)        ,intent(out)    :: h5_atypeid
 490   integer               ,intent(in)     :: Count
 491   integer               ,intent(out)    :: OutCount
 492   integer               ,intent(out)    :: Status
 493   integer(hid_t)                        :: h5_aspaceid
 494   integer                               :: hdf5err
 495   integer                               :: rank
 496   integer(hsize_t)                      :: npoints
 497
 498   type(wrf_phdf5_data_handle),pointer    :: DH
 499
 500
 501   call GetDH(DataHandle,DH,Status)
 502   if(Status /= WRF_NO_ERR) then
 503      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 504      call wrf_debug ( WARN , msg)
 505      return
 506   endif
 507
 508   if(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
 509
 510      call h5aget_type_f(h5_attrid,h5_atypeid,hdf5err)
 511      if(hdf5err.lt.0) then
 512        Status =  WRF_HDF5_ERR_DATATYPE
 513        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 514        call wrf_debug ( WARN , msg)
 515        return
 516     endif
 517
 518      call h5aget_space_f(h5_attrid,h5_aspaceid,hdf5err)
 519      if(hdf5err.lt.0) then
 520        Status =  WRF_HDF5_ERR_DATASPACE
 521        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 522        call wrf_debug ( WARN , msg)
 523        return
 524     endif
 525
 526      call h5sget_simple_extent_ndims_f(h5_aspaceid,rank,hdf5err)
 527      if(hdf5err.lt.0) then
 528        Status =  WRF_HDF5_ERR_DATASPACE
 529        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 530        call wrf_debug ( WARN , msg)
 531        return
 532      endif
 533
 534      if(rank > 1) then
 535         ! The rank can be either 0 or 1
 536         Status = WRF_HDF5_ERR_OTHERS
 537         write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 538        call wrf_debug ( WARN , msg)
 539         return
 540      endif
 541
 542      call h5sget_simple_extent_npoints_f(h5_aspaceid,npoints,hdf5err)
 543      if(hdf5err.lt.0) then
 544        Status =  WRF_HDF5_ERR_DATASPACE
 545        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 546        call wrf_debug ( WARN , msg)
 547        return
 548      endif
 549
 550      OutCount = npoints
 551      if(npoints > Count) then
 552         OutCount = Count
 553         Status = WRF_ERR_WARN_MORE_DATA_IN_FILE
 554      else
 555         OutCount = npoints
 556      endif
 557   endif
 558   return
 559 end subroutine retrieve_ti_info
 560
 561 subroutine setup_wrtd_dataset(DataHandle,DataSetName,dtypeid,countmd,&
 562                               dsetid,dspace_id,fspace_id,tgroupid,   &
 563                               TimeIndex,Status)
 564
 565   use wrf_phdf5_data
 566   use ext_phdf5_support_routines
 567   USE HDF5 ! This module contains all necessary modules
 568   implicit none
 569   include 'wrf_status_codes.h'
 570
 571   integer               ,intent(in)             :: DataHandle
 572   character*(*)         ,intent(in)             :: DataSetName
 573   integer(hid_t)        ,intent(in)             :: dtypeid
 574   integer               ,intent(in)             :: countmd
 575   integer               ,intent(in)             :: TimeIndex
 576
 577   integer(hid_t)        ,intent(out)            :: dsetid
 578   integer(hid_t)        ,intent(out)            :: dspace_id
 579   integer(hid_t)        ,intent(out)            :: fspace_id
 580   integer(hid_t)        ,intent(out)            :: tgroupid
 581   integer(hid_t)                                :: crp_list
 582   integer               ,intent(out)            :: Status
 583
 584   integer(hsize_t)      ,dimension(1)           :: sizes
 585   integer(hsize_t)      ,dimension(1)           :: chunk_dims
 586   integer(hsize_t)      ,dimension(1)           :: dims
 587   integer(hsize_t)      ,dimension(1)           :: hdf5_maxdims
 588   integer(hsize_t)      ,dimension(1)           :: offset
 589   integer(hsize_t)      ,dimension(1)           :: count
 590   type(wrf_phdf5_data_handle),pointer           :: DH
 591
 592   character(Len = MaxTimeSLen)                 :: tname
 593   character(Len = 256)                         :: tgroupname
 594   integer                                       :: hdf5err
 595
 596
 597   ! get datahandle
 598   call GetDH(DataHandle,DH,Status)
 599   if(Status /= WRF_NO_ERR) then
 600      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 601      call wrf_debug ( WARN , msg)
 602      return
 603   endif
 604
 605
 606   chunk_dims(1)   = countmd
 607
 608   dims(1)         = countmd
 609
 610   count(1)        = countmd
 611
 612   offset(1)       = 0
 613
 614   sizes(1)        = countmd
 615
 616   hdf5_maxdims(1) = countmd
 617
 618   ! create the memory space id
 619   call h5screate_simple_f(1,dims,dspace_id,hdf5err,dims)
 620   if(hdf5err.lt.0) then
 621      Status =  WRF_HDF5_ERR_DATASPACE
 622      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 623      call wrf_debug ( WARN , msg)
 624      return
 625   endif
 626
 627   ! create file space(for parallel module, each dataset per time step)
 628   call h5screate_simple_f(1,dims,fspace_id,hdf5err,hdf5_maxdims)
 629   if(hdf5err.lt.0) then
 630        Status =  WRF_HDF5_ERR_DATASPACE
 631        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 632        call wrf_debug ( WARN , msg)
 633        return
 634    endif
 635
 636   ! obtain the absolute name of the group where the dataset is located
 637   call numtochar(TimeIndex,tname)
 638   tgroupname = 'TIME_STAMP_'//tname
 639   call h5gopen_f(DH%GroupID,tgroupname,tgroupid,hdf5err)
 640
 641    ! create dataset
 642   call h5dcreate_f(tgroupid,DatasetName,H5T_NATIVE_REAL,fspace_id,&
 643                     dsetid,hdf5err)
 644    if(hdf5err.lt.0) then
 645         Status =  WRF_HDF5_ERR_DATASET_CREATE
 646        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 647        call wrf_debug ( WARN , msg)
 648         write(*,*) "cannot create an HDF5 dataset "
 649         return
 650    endif
 651
 652    return
 653  end subroutine setup_wrtd_dataset
 654
 655  subroutine extend_wrtd_dataset(DataHandle,TimeIndex,countmd,dsetid,dspaceid,&
 656                                 fspaceid,Status)
 657
 658   use wrf_phdf5_data
 659   use ext_phdf5_support_routines
 660   USE HDF5 ! This module contains all necessary modules
 661   implicit none
 662   include 'wrf_status_codes.h'
 663
 664   integer               ,intent(in)             :: DataHandle
 665   integer               ,intent(in)             :: countmd
 666   integer               ,intent(in)             :: TimeIndex
 667
 668   integer(hid_t)        ,intent(out)            :: dsetid
 669   integer(hid_t)        ,intent(out)            :: dspaceid
 670   integer(hid_t)        ,intent(out)            :: fspaceid
 671   integer               ,intent(out)            :: Status
 672
 673   integer(hsize_t)      ,dimension(2)           :: sizes
 674   integer(hsize_t)      ,dimension(2)           :: chunk_dims
 675   integer(hsize_t)      ,dimension(2)           :: dims
 676   integer(hsize_t)      ,dimension(2)           :: hdf5_maxdims
 677   integer(hsize_t)      ,dimension(2)           :: offset
 678   integer(hsize_t)      ,dimension(2)           :: count
 679
 680   integer                                       :: hdf5err
 681
 682   sizes(1)    = countmd
 683   sizes(2)    = TimeIndex
 684   offset(1)   = 0
 685   offset(2)   = TimeIndex - 1
 686   count(1)    = countmd
 687   count(2)    = 1
 688   dims(1)     = countmd
 689   dims(2)     = 1
 690
 691   ! extend the dataset
 692   CALL h5dextend_f(dsetid,sizes,hdf5err)
 693   if(hdf5err.lt.0) then
 694        Status =  WRF_HDF5_ERR_DATASET_GENERAL
 695        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 696        call wrf_debug ( WARN , msg)
 697         write(*,*) "cannot extend an HDF5 dataset in index ",TimeIndex
 698         return
 699   endif
 700
 701   ! obtain file space id
 702   CALL h5dget_space_f(dsetid,fspaceid,hdf5err)
 703   if(hdf5err.lt.0) then
 704        Status =  WRF_HDF5_ERR_DATASPACE
 705        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 706        call wrf_debug ( WARN , msg)
 707        return
 708   endif
 709
 710
 711   CALL h5sselect_hyperslab_f(fspaceid, H5S_SELECT_SET_F, &
 712                                 offset, count, hdf5err)
 713   if(hdf5err.lt.0) then
 714         Status =  WRF_HDF5_ERR_DATASET_GENERAL
 715        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 716        call wrf_debug ( WARN , msg)
 717         write(*,*) "cannot select hyperslab"
 718         return
 719   endif
 720
 721   ! create the memory space id
 722   call h5screate_simple_f(2,dims,dspaceid,hdf5err,dims)
 723   if(hdf5err.lt.0) then
 724      Status =  WRF_HDF5_ERR_DATASPACE
 725      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 726      call wrf_debug ( WARN , msg)
 727      write(*,*) "cannot create HDF5 memory data space"
 728      return
 729   endif
 730
 731   return
 732 end subroutine extend_wrtd_dataset
 733
 734 subroutine setup_rdtd_dataset(DataHandle,DataSetName,mtypeid,TimeIndex,&
 735                              countmd,outcountmd,dset_id,memspaceid,    &
 736                              dspace_id,tgroupid,Status)
 737
 738   use wrf_phdf5_data
 739   use ext_phdf5_support_routines
 740   USE HDF5 ! This module contains all necessary modules
 741   implicit none
 742   include 'wrf_status_codes.h'
 743
 744   integer               ,intent(in)             :: DataHandle
 745   character*(*)         ,intent(in)             :: DataSetName
 746   integer               ,intent(in)             :: countmd
 747   integer               ,intent(out)            :: outcountmd
 748   integer               ,intent(inout)          :: mtypeid
 749   integer               ,intent(in)             :: TimeIndex
 750
 751   integer(hid_t)        ,intent(out)            :: dset_id
 752   integer(hid_t)        ,intent(out)            :: dspace_id
 753   integer(hid_t)        ,intent(out)            :: memspaceid
 754   integer(hid_t)        ,intent(out)            :: tgroupid
 755   integer               ,intent(out)            :: Status
 756
 757   integer(hid_t)                                :: dtype_id
 758   integer(hid_t)                                :: class_type
 759   integer(hsize_t)      ,dimension(1)           :: sizes
 760   integer(hsize_t)      ,dimension(1)           :: dims
 761   integer(hsize_t)      ,dimension(1)           :: h5_dims
 762   integer(hsize_t)      ,dimension(1)           :: hdf5_maxdims
 763   integer(hsize_t)      ,dimension(1)           :: offset
 764   integer(hsize_t)      ,dimension(1)           :: count
 765   integer                                       :: StoredDim
 766   type(wrf_phdf5_data_handle),pointer            :: DH
 767
 768   logical                                       :: flag
 769   integer                                       :: hdf5err
 770
 771   character(Len = MaxTimeSLen)                 :: tname
 772   character(Len = 256)                         :: tgroupname
 773   ! get datahandle
 774   call GetDH(DataHandle,DH,Status)
 775   if(Status /= WRF_NO_ERR) then
 776      write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 777      call wrf_debug ( WARN , msg)
 778      return
 779   endif
 780
 781   ! obtain the absolute name of the group where the dataset is located
 782   call numtochar(TimeIndex,tname)
 783   tgroupname = 'TIME_STAMP_'//tname
 784   call h5gopen_f(DH%GroupID,tgroupname,tgroupid,hdf5err)
 785
 786   ! Obtain HDF5 dataset id
 787   call h5dopen_f(tgroupid,DataSetName,dset_id,hdf5err)
 788   if(hdf5err.lt.0) then
 789            Status = WRF_HDF5_ERR_DATASET_OPEN
 790            write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 791            call wrf_debug ( WARN , msg)
 792            return
 793   endif
 794
 795   ! Obtain the datatype
 796    call h5dget_type_f(dset_id,dtype_id,hdf5err)
 797    if(hdf5err.lt.0) then
 798            Status = WRF_HDF5_ERR_DATASET_GENERAL
 799            write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 800            call wrf_debug ( WARN , msg)
 801            return
 802    endif
 803
 804     call h5tget_class_f(dtype_id,class_type,hdf5err)
 805     if(hdf5err.lt.0) then
 806            Status = WRF_HDF5_ERR_DATATYPE
 807            write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 808            call wrf_debug ( WARN , msg)
 809            return
 810     endif
 811
 812
 813     if(mtypeid == H5T_NATIVE_REAL .or. mtypeid == H5T_NATIVE_DOUBLE) then
 814        if( class_type /= H5T_FLOAT_F)  then
 815            Status = WRF_HDF5_ERR_TYPE_MISMATCH
 816            write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
 817            call wrf_debug ( WARN , msg)
 818            return
 819         endif
 820      else if(mtypeid ==H5T_NATIVE_CHARACTER) then
 821         if(class_type /= H5T_STRING_F) then
 822            Status = WRF_HDF5_ERR_TYPE_MISMATCH
 823            write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
 824            call wrf_debug ( WARN , msg)
 825            return
 826         endif
 827      else if(mtypeid == H5T_NATIVE_INTEGER) then
 828         if(class_type /= H5T_INTEGER_F) then
 829            Status = WRF_HDF5_ERR_TYPE_MISMATCH
 830            write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
 831            call wrf_debug ( WARN , msg)
 832            return
 833         endif
 834      else if(mtypeid == DH%EnumID) then
 835         if(class_type /= H5T_ENUM_F) then
 836            Status = WRF_HDF5_ERR_TYPE_MISMATCH
 837            write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
 838            call wrf_debug ( WARN , msg)
 839            return
 840         endif
 841         call h5tequal_f(dtype_id,DH%EnumID,flag,hdf5err)
 842         if(hdf5err.lt.0) then
 843            Status = WRF_HDF5_ERR_DATASET_OPEN
 844            write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 845            call wrf_debug ( WARN , msg)
 846            return
 847         endif
 848         if(flag .EQV. .FALSE.) then
 849            Status = WRF_HDF5_ERR_TYPE_MISMATCH
 850            write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
 851            call wrf_debug ( WARN , msg)
 852            return
 853         endif
 854      else
 855         Status = WRF_HDF5_ERR_BAD_DATA_TYPE
 856         write(msg,*)'Fatal Non-WRF supported TYPE in ',__FILE__,', line',__LINE__
 857         call wrf_debug(FATAL, msg)
 858         return
 859      endif
 860      ! update string id
 861      if(mtypeid == H5T_NATIVE_CHARACTER) then
 862             mtypeid = dtype_id
 863      endif
 864
 865      ! Obtain the dataspace
 866      call h5dget_space_f(dset_id,dspace_id,hdf5err)
 867      if(hdf5err.lt.0) then
 868            Status = WRF_HDF5_ERR_DATASPACE
 869            write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 870            call wrf_debug ( WARN , msg)
 871            return
 872      endif
 873
 874      ! Obtain the rank of the dimension
 875      call h5sget_simple_extent_ndims_f(dspace_id,StoredDim,hdf5err)
 876      if(hdf5err.lt.0) then
 877            Status = WRF_HDF5_ERR_DATASPACE
 878            write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 879            call wrf_debug ( WARN , msg)
 880            return
 881      endif
 882
 883
 884      if(StoredDim /=1) then
 885           Status = WRF_HDF5_ERR_DATASPACE
 886           write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 887           call wrf_debug ( WARN , msg)
 888           return
 889      endif
 890
 891
 892      call h5sget_simple_extent_dims_f(dspace_id,h5_dims,hdf5_maxdims,hdf5err)
 893      if(hdf5err.lt.0) then
 894            Status = WRF_HDF5_ERR_DATASPACE
 895            write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 896            call wrf_debug ( WARN , msg)
 897            return
 898      endif
 899
 900
 901      if(countmd <= 0) then
 902            Status = WRF_HDF5_ERR_ZERO_LENGTH_READ
 903            write(msg,*) 'Warning ZERO LENGTH READ in ',__FILE__,', line', __LINE__
 904            call wrf_debug ( WARN , msg)
 905            return
 906      endif
 907
 908      if(countmd .lt. h5_dims(1)) then
 909         outcountmd = countmd
 910      else
 911         outcountmd = h5_dims(1)
 912      endif
 913
 914      ! create memspace_id
 915      dims(1) = outcountmd
 916
 917      call h5screate_simple_f(1,dims,memspaceid,hdf5err)
 918      if(hdf5err.lt.0) then
 919            Status = WRF_HDF5_ERR_DATASPACE
 920            write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 921            call wrf_debug ( WARN , msg)
 922            return
 923      endif
 924
 925      offset(1) = 0
 926      count(1)  = outcountmd
 927
 928      return
 929 end subroutine setup_rdtd_dataset
 930
 931 subroutine make_strid(str_len,str_id,Status)
 932
 933   use wrf_phdf5_data
 934   USE HDF5 ! This module contains all necessary modules
 935   implicit none
 936   include 'wrf_status_codes.h'
 937
 938   integer      ,intent(in)         :: str_len
 939   integer(hid_t),intent(out)       :: str_id
 940   integer       ,intent(out)       :: Status
 941   integer(size_t)                  :: str_lensize
 942   integer                          :: hdf5err
 943
 944   Status = WRF_NO_ERR
 945   if(str_len <= 0) then
 946     Status = WRF_HDF5_ERR_ATTRIBUTE_GENERAL
 947     write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 948     call wrf_debug ( WARN , msg)
 949     return
 950   endif
 951
 952   call h5tcopy_f(H5T_NATIVE_CHARACTER,str_id,hdf5err)
 953   if(hdf5err.lt.0) then
 954        Status =  WRF_HDF5_ERR_DATATYPE
 955        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 956        call wrf_debug ( WARN , msg)
 957        return
 958   endif
 959
 960    str_lensize = str_len
 961    call h5tset_size_f(str_id,str_lensize,hdf5err)
 962    if(hdf5err.lt.0) then
 963        Status =  WRF_HDF5_ERR_DATATYPE
 964        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 965        call wrf_debug ( WARN , msg)
 966        return
 967     endif
 968
 969    call h5tset_strpad_f(str_id,H5T_STR_SPACEPAD_F,hdf5err)
 970     if(hdf5err.lt.0) then
 971        Status =  WRF_HDF5_ERR_DATATYPE
 972        write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
 973        call wrf_debug ( WARN , msg)
 974        return
 975     endif
 976
 977 end subroutine make_strid