Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

wrf-phdf5.F90 @ 1

Last change on this file since 1 was 1, checked in by lfita, 10 years ago

-- --- Opening of the WRF+LMDZ coupling repository --- -- -

WRF: version v3.3
LMDZ: version v1818

More details in:

File size: 180.9 KB

Line
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	real8 ,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	real8 ,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	real8 ,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	real8 ,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	real8 ,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	real8 ,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	real8 ,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	real8 ,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

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

Original Format