Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

wrf_io.F90 @ 2759

Last change on this file since 2759 was 2759, checked in by aslmd, 2 years ago
adding unmodified code from WRFV3.0.1.1, expurged from useless data +1M size
File size: 118.0 KB

Line
1	!/*------------------------------------------------------------------------------
2	!* Standard Disclaimer
3	!*
4	!* Forecast Systems Laboratory
5	!* NOAA/OAR/ERL/FSL
6	!* 325 Broadway
7	!* Boulder, CO 80303
8	!*
9	!* AVIATION DIVISION
10	!* ADVANCED COMPUTING BRANCH
11	!* SMS/NNT Version: 2.0.0
12	!*
13	!* This software and its documentation are in the public domain and
14	!* are furnished "as is". The United States government, its
15	!* instrumentalities, officers, employees, and agents make no
16	!* warranty, express or implied, as to the usefulness of the software
17	!* and documentation for any purpose. They assume no
18	!* responsibility (1) for the use of the software and documentation;
19	!* or (2) to provide technical support to users.
20	!*
21	!* Permission to use, copy, modify, and distribute this software is
22	!* hereby granted, provided that this disclaimer notice appears in
23	!* all copies. All modifications to this software must be clearly
24	!* documented, and are solely the responsibility of the agent making
25	!* the modification. If significant modifications or enhancements
26	!* are made to this software, the SMS Development team
27	!* (sms-info@fsl.noaa.gov) should be notified.
28	!*
29	!*----------------------------------------------------------------------------
30	!*
31	!* WRF NetCDF I/O
32	! Author: Jacques Middlecoff jacquesm@fsl.noaa.gov
33	!* Date: October 6, 2000
34	!*
35	!*----------------------------------------------------------------------------
36	!*/
37
38	module wrf_data_pnc
39
40	integer , parameter :: FATAL = 1
41	integer , parameter :: WARN = 1
42	integer , parameter :: WrfDataHandleMax = 99
43	integer , parameter :: MaxDims = 2000 ! = NF_MAX_VARS
44	integer , parameter :: MaxVars = 2000
45	integer , parameter :: MaxTimes = 9000000
46	integer , parameter :: DateStrLen = 19
47	integer , parameter :: VarNameLen = 31
48	integer , parameter :: NO_DIM = 0
49	integer , parameter :: NVarDims = 4
50	integer , parameter :: NMDVarDims = 2
51	character (8) , parameter :: NO_NAME = 'NULL'
52	character (DateStrLen) , parameter :: ZeroDate = '0000-00-00-00:00:00'
53
54	#include "wrf_io_flags.h"
55
56	character (256) :: msg
57	logical :: WrfIOnotInitialized = .true.
58
59	type :: wrf_data_handle
60	character (255) :: FileName
61	integer :: FileStatus
62	integer :: Comm
63	integer :: NCID
64	logical :: Free
65	logical :: Write
66	character (5) :: TimesName
67	integer :: TimeIndex
68	integer :: CurrentTime !Only used for read
69	integer :: NumberTimes !Only used for read
70	character (DateStrLen), pointer :: Times(:)
71	integer :: TimesVarID
72	integer , pointer :: DimLengths(:)
73	integer , pointer :: DimIDs(:)
74	character (31) , pointer :: DimNames(:)
75	integer :: DimUnlimID
76	character (9) :: DimUnlimName
77	integer , dimension(NVarDims) :: DimID
78	integer , dimension(NVarDims) :: Dimension
79	integer , pointer :: MDVarIDs(:)
80	integer , pointer :: MDVarDimLens(:)
81	character (80) , pointer :: MDVarNames(:)
82	integer , pointer :: VarIDs(:)
83	integer , pointer :: VarDimLens(:,:)
84	character (VarNameLen), pointer :: VarNames(:)
85	integer :: CurrentVariable !Only used for read
86	integer :: NumVars
87	! first_operation is set to .TRUE. when a new handle is allocated
88	! or when open-for-write or open-for-read are committed. It is set
89	! to .FALSE. when the first field is read or written.
90	logical :: first_operation
91	end type wrf_data_handle
92	type(wrf_data_handle),target :: WrfDataHandles(WrfDataHandleMax)
93	end module wrf_data_pnc
94
95	module ext_pnc_support_routines
96
97	implicit none
98	include 'mpif.h'
99
100	CONTAINS
101
102	integer(KIND=MPI_OFFSET_KIND) function i2offset(i)
103	integer i
104	i2offset = i
105	return
106	end function i2offset
107
108	subroutine allocHandle(DataHandle,DH,Comm,Status)
109	use wrf_data_pnc
110	include 'wrf_status_codes.h'
111	integer ,intent(out) :: DataHandle
112	type(wrf_data_handle),pointer :: DH
113	integer ,intent(IN) :: Comm
114	integer ,intent(out) :: Status
115	integer :: i
116	integer :: stat
117
118	do i=1,WrfDataHandleMax
119	if(WrfDataHandles(i)%Free) then
120	DH => WrfDataHandles(i)
121	DataHandle = i
122	allocate(DH%Times(MaxTimes), STAT=stat)
123	if(stat/= 0) then
124	Status = WRF_ERR_FATAL_ALLOCATION_ERROR
125	write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
126	call wrf_debug ( FATAL , msg)
127	return
128	endif
129	allocate(DH%DimLengths(MaxDims), STAT=stat)
130	if(stat/= 0) then
131	Status = WRF_ERR_FATAL_ALLOCATION_ERROR
132	write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
133	call wrf_debug ( FATAL , msg)
134	return
135	endif
136	allocate(DH%DimIDs(MaxDims), STAT=stat)
137	if(stat/= 0) then
138	Status = WRF_ERR_FATAL_ALLOCATION_ERROR
139	write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
140	call wrf_debug ( FATAL , msg)
141	return
142	endif
143	allocate(DH%DimNames(MaxDims), STAT=stat)
144	if(stat/= 0) then
145	Status = WRF_ERR_FATAL_ALLOCATION_ERROR
146	write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
147	call wrf_debug ( FATAL , msg)
148	return
149	endif
150	allocate(DH%MDVarIDs(MaxVars), STAT=stat)
151	if(stat/= 0) then
152	Status = WRF_ERR_FATAL_ALLOCATION_ERROR
153	write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
154	call wrf_debug ( FATAL , msg)
155	return
156	endif
157	allocate(DH%MDVarDimLens(MaxVars), STAT=stat)
158	if(stat/= 0) then
159	Status = WRF_ERR_FATAL_ALLOCATION_ERROR
160	write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
161	call wrf_debug ( FATAL , msg)
162	return
163	endif
164	allocate(DH%MDVarNames(MaxVars), STAT=stat)
165	if(stat/= 0) then
166	Status = WRF_ERR_FATAL_ALLOCATION_ERROR
167	write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
168	call wrf_debug ( FATAL , msg)
169	return
170	endif
171	allocate(DH%VarIDs(MaxVars), STAT=stat)
172	if(stat/= 0) then
173	Status = WRF_ERR_FATAL_ALLOCATION_ERROR
174	write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
175	call wrf_debug ( FATAL , msg)
176	return
177	endif
178	allocate(DH%VarDimLens(NVarDims-1,MaxVars), STAT=stat)
179	if(stat/= 0) then
180	Status = WRF_ERR_FATAL_ALLOCATION_ERROR
181	write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
182	call wrf_debug ( FATAL , msg)
183	return
184	endif
185	allocate(DH%VarNames(MaxVars), STAT=stat)
186	if(stat/= 0) then
187	Status = WRF_ERR_FATAL_ALLOCATION_ERROR
188	write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
189	call wrf_debug ( FATAL , msg)
190	return
191	endif
192	exit
193	endif
194	if(i==WrfDataHandleMax) then
195	Status = WRF_WARN_TOO_MANY_FILES
196	write(msg,*) 'Warning TOO MANY FILES in ',__FILE__,', line', __LINE__
197	call wrf_debug ( WARN , TRIM(msg))
198	write(msg,*) 'Did you call ext_pnc_ioinit?'
199	call wrf_debug ( WARN , TRIM(msg))
200	return
201	endif
202	enddo
203	DH%Free =.false.
204	DH%Comm = Comm
205	DH%Write =.false.
206	DH%first_operation = .TRUE.
207	Status = WRF_NO_ERR
208	end subroutine allocHandle
209
210	subroutine deallocHandle(DataHandle, Status)
211	use wrf_data_pnc
212	include 'wrf_status_codes.h'
213	integer ,intent(in) :: DataHandle
214	integer ,intent(out) :: Status
215	type(wrf_data_handle),pointer :: DH
216	integer :: i
217	integer :: stat
218
219	IF ( DataHandle .GE. 1 .AND. DataHandle .LE. WrfDataHandleMax ) THEN
220	if(.NOT. WrfDataHandles(DataHandle)%Free) then
221	DH => WrfDataHandles(DataHandle)
222	deallocate(DH%Times, STAT=stat)
223	if(stat/= 0) then
224	Status = WRF_ERR_FATAL_DEALLOCATION_ERR
225	write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
226	call wrf_debug ( FATAL , msg)
227	return
228	endif
229	deallocate(DH%DimLengths, STAT=stat)
230	if(stat/= 0) then
231	Status = WRF_ERR_FATAL_DEALLOCATION_ERR
232	write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
233	call wrf_debug ( FATAL , msg)
234	return
235	endif
236	deallocate(DH%DimIDs, STAT=stat)
237	if(stat/= 0) then
238	Status = WRF_ERR_FATAL_DEALLOCATION_ERR
239	write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
240	call wrf_debug ( FATAL , msg)
241	return
242	endif
243	deallocate(DH%DimNames, STAT=stat)
244	if(stat/= 0) then
245	Status = WRF_ERR_FATAL_DEALLOCATION_ERR
246	write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
247	call wrf_debug ( FATAL , msg)
248	return
249	endif
250	deallocate(DH%MDVarIDs, STAT=stat)
251	if(stat/= 0) then
252	Status = WRF_ERR_FATAL_DEALLOCATION_ERR
253	write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
254	call wrf_debug ( FATAL , msg)
255	return
256	endif
257	deallocate(DH%MDVarDimLens, STAT=stat)
258	if(stat/= 0) then
259	Status = WRF_ERR_FATAL_DEALLOCATION_ERR
260	write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
261	call wrf_debug ( FATAL , msg)
262	return
263	endif
264	deallocate(DH%MDVarNames, STAT=stat)
265	if(stat/= 0) then
266	Status = WRF_ERR_FATAL_DEALLOCATION_ERR
267	write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
268	call wrf_debug ( FATAL , msg)
269	return
270	endif
271	deallocate(DH%VarIDs, STAT=stat)
272	if(stat/= 0) then
273	Status = WRF_ERR_FATAL_DEALLOCATION_ERR
274	write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
275	call wrf_debug ( FATAL , msg)
276	return
277	endif
278	deallocate(DH%VarDimLens, STAT=stat)
279	if(stat/= 0) then
280	Status = WRF_ERR_FATAL_DEALLOCATION_ERR
281	write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
282	call wrf_debug ( FATAL , msg)
283	return
284	endif
285	deallocate(DH%VarNames, STAT=stat)
286	if(stat/= 0) then
287	Status = WRF_ERR_FATAL_DEALLOCATION_ERR
288	write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
289	call wrf_debug ( FATAL , msg)
290	return
291	endif
292	DH%Free =.TRUE.
293	endif
294	ENDIF
295	Status = WRF_NO_ERR
296	end subroutine deallocHandle
297
298	subroutine GetDH(DataHandle,DH,Status)
299	use wrf_data_pnc
300	include 'wrf_status_codes.h'
301	integer ,intent(in) :: DataHandle
302	type(wrf_data_handle) ,pointer :: DH
303	integer ,intent(out) :: Status
304
305	if(DataHandle < 1 .or. DataHandle > WrfDataHandleMax) then
306	Status = WRF_WARN_BAD_DATA_HANDLE
307	return
308	endif
309	DH => WrfDataHandles(DataHandle)
310	if(DH%Free) then
311	Status = WRF_WARN_BAD_DATA_HANDLE
312	return
313	endif
314	Status = WRF_NO_ERR
315	return
316	end subroutine GetDH
317
318	subroutine DateCheck(Date,Status)
319	use wrf_data_pnc
320	include 'wrf_status_codes.h'
321	character() ,intent(in) :: Date
322	integer ,intent(out) :: Status
323
324	if(len(Date) /= DateStrLen) then
325	Status = WRF_WARN_DATESTR_BAD_LENGTH
326	else
327	Status = WRF_NO_ERR
328	endif
329	return
330	end subroutine DateCheck
331
332	subroutine GetName(Element,Var,Name,Status)
333	use wrf_data_pnc
334	include 'wrf_status_codes.h'
335	character() ,intent(in) :: Element
336	character() ,intent(in) :: Var
337	character() ,intent(out) :: Name
338	integer ,intent(out) :: Status
339	character (VarNameLen) :: VarName
340	character (1) :: c
341	integer :: i
342	integer, parameter :: upper_to_lower =IACHAR('a')-IACHAR('A')
343
344	VarName = Var
345	Name = 'MD___'//trim(Element)//VarName
346	do i=1,len(Name)
347	c=Name(i:i)
348	if('A'<=c .and. c <='Z') Name(i:i)=achar(iachar(c)+upper_to_lower)
349	if(c=='-'.or.c==':') Name(i:i)='_'
350	enddo
351	Status = WRF_NO_ERR
352	return
353	end subroutine GetName
354
355	subroutine GetTimeIndex(IO,DataHandle,DateStr,TimeIndex,Status)
356	use wrf_data_pnc
357	include 'wrf_status_codes.h'
358	# include "pnetcdf.inc"
359	character (*) ,intent(in) :: IO
360	integer ,intent(in) :: DataHandle
361	character() ,intent(in) :: DateStr
362	integer ,intent(out) :: TimeIndex
363	integer ,intent(out) :: Status
364	type(wrf_data_handle) ,pointer :: DH
365	integer(KIND=MPI_OFFSET_KIND) :: VStart(2)
366	integer(KIND=MPI_OFFSET_KIND) :: VCount(2)
367	integer :: stat
368	integer :: i
369
370	DH => WrfDataHandles(DataHandle)
371	call DateCheck(DateStr,Status)
372	if(Status /= WRF_NO_ERR) then
373	Status = WRF_WARN_DATESTR_ERROR
374	write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__
375	call wrf_debug ( WARN , TRIM(msg))
376	return
377	endif
378	if(IO == 'write') then
379	TimeIndex = DH%TimeIndex
380	if(TimeIndex <= 0) then
381	TimeIndex = 1
382	elseif(DateStr == DH%Times(TimeIndex)) then
383	Status = WRF_NO_ERR
384	return
385	else
386	TimeIndex = TimeIndex +1
387	if(TimeIndex > MaxTimes) then
388	Status = WRF_WARN_TIME_EOF
389	write(msg,*) 'Warning TIME EOF in ',__FILE__,', line', __LINE__
390	call wrf_debug ( WARN , TRIM(msg))
391	return
392	endif
393	endif
394	DH%TimeIndex = TimeIndex
395	DH%Times(TimeIndex) = DateStr
396	VStart(1) = 1
397	VStart(2) = TimeIndex
398	VCount(1) = DateStrLen
399	VCount(2) = 1
400	stat = NFMPI_PUT_VARA_TEXT_ALL(DH%NCID,DH%TimesVarID,VStart,VCount,DateStr)
401	call netcdf_err(stat,Status)
402	if(Status /= WRF_NO_ERR) then
403	write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
404	call wrf_debug ( WARN , TRIM(msg))
405	return
406	endif
407	else
408	do i=1,MaxTimes
409	if(DH%Times(i)==DateStr) then
410	Status = WRF_NO_ERR
411	TimeIndex = i
412	exit
413	endif
414	if(i==MaxTimes) then
415	Status = WRF_WARN_TIME_NF
416	write(msg,*) 'Warning TIME ',DateStr,' NOT FOUND in ',__FILE__,', line', __LINE__
417	call wrf_debug ( WARN , TRIM(msg))
418	return
419	endif
420	enddo
421	endif
422	return
423	end subroutine GetTimeIndex
424
425	subroutine GetDim(MemoryOrder,NDim,Status)
426	include 'wrf_status_codes.h'
427	character() ,intent(in) :: MemoryOrder
428	integer ,intent(out) :: NDim
429	integer ,intent(out) :: Status
430	character*3 :: MemOrd
431
432	call LowerCase(MemoryOrder,MemOrd)
433	select case (MemOrd)
434	case ('xyz','xzy','yxz','yzx','zxy','zyx','xsz','xez','ysz','yez')
435	NDim = 3
436	case ('xy','yx','xs','xe','ys','ye')
437	NDim = 2
438	case ('z','c')
439	NDim = 1
440	case ('0') ! NDim=0 for scalars. TBH: 20060502
441	NDim = 0
442	case default
443	print *, 'memory order = ',MemOrd,' ',MemoryOrder
444	Status = WRF_WARN_BAD_MEMORYORDER
445	return
446	end select
447	Status = WRF_NO_ERR
448	return
449	end subroutine GetDim
450
451	subroutine GetIndices(NDim,Start,End,i1,i2,j1,j2,k1,k2)
452	integer ,intent(in) :: NDim
453	integer ,dimension(*),intent(in) :: Start,End
454	integer ,intent(out) :: i1,i2,j1,j2,k1,k2
455
456	i1=1
457	i2=1
458	j1=1
459	j2=1
460	k1=1
461	k2=1
462	if(NDim == 0) return ! NDim=0 for scalars. TBH: 20060502
463	i1 = Start(1)
464	i2 = End (1)
465	if(NDim == 1) return
466	j1 = Start(2)
467	j2 = End (2)
468	if(NDim == 2) return
469	k1 = Start(3)
470	k2 = End (3)
471	return
472	end subroutine GetIndices
473
474	subroutine ExtOrder(MemoryOrder,Vector,Status)
475	use wrf_data_pnc
476	include 'wrf_status_codes.h'
477	character() ,intent(in) :: MemoryOrder
478	integer,dimension(*) ,intent(inout) :: Vector
479	integer ,intent(out) :: Status
480	integer :: NDim
481	integer,dimension(NVarDims) :: temp
482	character*3 :: MemOrd
483
484	call GetDim(MemoryOrder,NDim,Status)
485	temp(1:NDim) = Vector(1:NDim)
486	call LowerCase(MemoryOrder,MemOrd)
487	select case (MemOrd)
488
489	case ('xyz','xsz','xez','ysz','yez','xy','xs','xe','ys','ye','z','c')
490	continue
491	case ('0')
492	continue ! NDim=0 for scalars. TBH: 20060502
493	case ('xzy')
494	Vector(2) = temp(3)
495	Vector(3) = temp(2)
496	case ('yxz')
497	Vector(1) = temp(2)
498	Vector(2) = temp(1)
499	case ('yzx')
500	Vector(1) = temp(3)
501	Vector(2) = temp(1)
502	Vector(3) = temp(2)
503	case ('zxy')
504	Vector(1) = temp(2)
505	Vector(2) = temp(3)
506	Vector(3) = temp(1)
507	case ('zyx')
508	Vector(1) = temp(3)
509	Vector(3) = temp(1)
510	case ('yx')
511	Vector(1) = temp(2)
512	Vector(2) = temp(1)
513	case default
514	Status = WRF_WARN_BAD_MEMORYORDER
515	return
516	end select
517	Status = WRF_NO_ERR
518	return
519	end subroutine ExtOrder
520
521	subroutine ExtOrderStr(MemoryOrder,Vector,ROVector,Status)
522	use wrf_data_pnc
523	include 'wrf_status_codes.h'
524	character() ,intent(in) :: MemoryOrder
525	character(),dimension(*) ,intent(in) :: Vector
526	character(80),dimension(NVarDims),intent(out) :: ROVector
527	integer ,intent(out) :: Status
528	integer :: NDim
529	character*3 :: MemOrd
530
531	call GetDim(MemoryOrder,NDim,Status)
532	ROVector(1:NDim) = Vector(1:NDim)
533	call LowerCase(MemoryOrder,MemOrd)
534	select case (MemOrd)
535
536	case ('xyz','xsz','xez','ysz','yez','xy','xs','xe','ys','ye','z','c')
537	continue
538	case ('0')
539	continue ! NDim=0 for scalars. TBH: 20060502
540	case ('xzy')
541	ROVector(2) = Vector(3)
542	ROVector(3) = Vector(2)
543	case ('yxz')
544	ROVector(1) = Vector(2)
545	ROVector(2) = Vector(1)
546	case ('yzx')
547	ROVector(1) = Vector(3)
548	ROVector(2) = Vector(1)
549	ROVector(3) = Vector(2)
550	case ('zxy')
551	ROVector(1) = Vector(2)
552	ROVector(2) = Vector(3)
553	ROVector(3) = Vector(1)
554	case ('zyx')
555	ROVector(1) = Vector(3)
556	ROVector(3) = Vector(1)
557	case ('yx')
558	ROVector(1) = Vector(2)
559	ROVector(2) = Vector(1)
560	case default
561	Status = WRF_WARN_BAD_MEMORYORDER
562	return
563	end select
564	Status = WRF_NO_ERR
565	return
566	end subroutine ExtOrderStr
567
568
569	subroutine LowerCase(MemoryOrder,MemOrd)
570	character() ,intent(in) :: MemoryOrder
571	character() ,intent(out) :: MemOrd
572	character*1 :: c
573	integer ,parameter :: upper_to_lower =IACHAR('a')-IACHAR('A')
574	integer :: i,N
575
576	MemOrd = ' '
577	N = len(MemoryOrder)
578	MemOrd(1:N) = MemoryOrder(1:N)
579	do i=1,N
580	c = MemoryOrder(i:i)
581	if('A'<=c .and. c <='Z') MemOrd(i:i)=achar(iachar(c)+upper_to_lower)
582	enddo
583	return
584	end subroutine LowerCase
585
586	subroutine UpperCase(MemoryOrder,MemOrd)
587	character() ,intent(in) :: MemoryOrder
588	character() ,intent(out) :: MemOrd
589	character*1 :: c
590	integer ,parameter :: lower_to_upper =IACHAR('A')-IACHAR('a')
591	integer :: i,N
592
593	MemOrd = ' '
594	N = len(MemoryOrder)
595	MemOrd(1:N) = MemoryOrder(1:N)
596	do i=1,N
597	c = MemoryOrder(i:i)
598	if('a'<=c .and. c <='z') MemOrd(i:i)=achar(iachar(c)+lower_to_upper)
599	enddo
600	return
601	end subroutine UpperCase
602
603	subroutine netcdf_err(err,Status)
604	use wrf_data_pnc
605	include 'wrf_status_codes.h'
606	# include "pnetcdf.inc"
607	integer ,intent(in) :: err
608	integer ,intent(out) :: Status
609	character(len=80) :: errmsg
610	integer :: stat
611
612	if( err==NF_NOERR )then
613	Status = WRF_NO_ERR
614	else
615	errmsg = NFMPI_STRERROR(err)
616	write(msg,*) 'NetCDF error: ',errmsg
617	call wrf_debug ( WARN , TRIM(msg))
618	Status = WRF_WARN_NETCDF
619	endif
620	return
621	end subroutine netcdf_err
622
623	subroutine FieldIO(IO,DataHandle,DateStr,Starts,Length,MemoryOrder &
624	,FieldType,NCID,VarID,XField,Status)
625	use wrf_data_pnc
626	include 'wrf_status_codes.h'
627	# include "pnetcdf.inc"
628	character (*) ,intent(in) :: IO
629	integer ,intent(in) :: DataHandle
630	character() ,intent(in) :: DateStr
631	integer,dimension(NVarDims),intent(in) :: Starts
632	integer,dimension(NVarDims),intent(in) :: Length
633	character() ,intent(in) :: MemoryOrder
634	integer ,intent(in) :: FieldType
635	integer ,intent(in) :: NCID
636	integer ,intent(in) :: VarID
637	integer,dimension(*) ,intent(inout) :: XField
638	integer ,intent(out) :: Status
639	integer :: TimeIndex
640	integer :: NDim
641	integer,dimension(NVarDims) :: VStart
642	integer,dimension(NVarDims) :: VCount
643
644	call GetTimeIndex(IO,DataHandle,DateStr,TimeIndex,Status)
645	if(Status /= WRF_NO_ERR) then
646	write(msg,*) 'Warning in ',__FILE__,', line', __LINE__
647	call wrf_debug ( WARN , TRIM(msg))
648	write(msg,*) ' Bad time index for DateStr = ',DateStr
649	call wrf_debug ( WARN , TRIM(msg))
650	return
651	endif
652	call GetDim(MemoryOrder,NDim,Status)
653	VStart(:) = 1
654	VCount(:) = 1
655	!jm for parallel netcef VStart(1:NDim) = 1
656	VStart(1:NDim) = Starts(1:NDim)
657	VCount(1:NDim) = Length(1:NDim)
658	VStart(NDim+1) = TimeIndex
659	VCount(NDim+1) = 1
660	select case (FieldType)
661	case (WRF_REAL)
662	call ext_pnc_RealFieldIO (IO,NCID,VarID,VStart,VCount,XField,Status)
663	case (WRF_DOUBLE)
664	call ext_pnc_DoubleFieldIO (IO,NCID,VarID,VStart,VCount,XField,Status)
665	case (WRF_INTEGER)
666	call ext_pnc_IntFieldIO (IO,NCID,VarID,VStart,VCount,XField,Status)
667	case (WRF_LOGICAL)
668	call ext_pnc_LogicalFieldIO (IO,NCID,VarID,VStart,VCount,XField,Status)
669	if(Status /= WRF_NO_ERR) return
670	case default
671	!for wrf_complex, double_complex
672	Status = WRF_WARN_DATA_TYPE_NOT_FOUND
673	write(msg,*) 'Warning DATA TYPE NOT FOUND in ',__FILE__,', line', __LINE__
674	call wrf_debug ( WARN , TRIM(msg))
675	return
676	end select
677	return
678	end subroutine FieldIO
679
680	subroutine Transpose(IO,MemoryOrder,di, Field,l1,l2,m1,m2,n1,n2 &
681	,XField,x1,x2,y1,y2,z1,z2 &
682	,i1,i2,j1,j2,k1,k2 )
683	character() ,intent(in) :: IO
684	character() ,intent(in) :: MemoryOrder
685	integer ,intent(in) :: l1,l2,m1,m2,n1,n2
686	integer ,intent(in) :: di
687	integer ,intent(in) :: x1,x2,y1,y2,z1,z2
688	integer ,intent(in) :: i1,i2,j1,j2,k1,k2
689	integer ,intent(inout) :: Field(di,l1:l2,m1:m2,n1:n2)
690	!jm 010827 integer ,intent(inout) :: XField(di,x1:x2,y1:y2,z1:z2)
691	integer ,intent(inout) :: XField(di,(i2-i1+1)(j2-j1+1)(k2-k1+1))
692	character*3 :: MemOrd
693	character*3 :: MemO
694	integer ,parameter :: MaxUpperCase=IACHAR('Z')
695	integer :: i,j,k,ix,jx,kx
696
697	call LowerCase(MemoryOrder,MemOrd)
698	select case (MemOrd)
699
700	!#define XDEX(A,B,C) A-A ## 1+1+(A ## 2-A ## 1+1)((B-B ## 1)+(C-C ## 1)(B ## 2-B ## 1+1))
701	! define(`XDEX',($1-``$1''1+1+(``$1''2-``$1''1+1)(($2-``$2''1)+($3-``$3''1)(``$2''2-``$2''1+1))))
702
703	case ('xzy')
704	#undef DFIELD
705	#define DFIELD XField(1:di,XDEX(i,k,j))
706	#include "transpose.code"
707	case ('xyz','xsz','xez','ysz','yez','xy','xs','xe','ys','ye','z','c','0')
708	#undef DFIELD
709	#define DFIELD XField(1:di,XDEX(i,j,k))
710	#include "transpose.code"
711	case ('yxz')
712	#undef DFIELD
713	#define DFIELD XField(1:di,XDEX(j,i,k))
714	#include "transpose.code"
715	case ('zxy')
716	#undef DFIELD
717	#define DFIELD XField(1:di,XDEX(k,i,j))
718	#include "transpose.code"
719	case ('yzx')
720	#undef DFIELD
721	#define DFIELD XField(1:di,XDEX(j,k,i))
722	#include "transpose.code"
723	case ('zyx')
724	#undef DFIELD
725	#define DFIELD XField(1:di,XDEX(k,j,i))
726	#include "transpose.code"
727	case ('yx')
728	#undef DFIELD
729	#define DFIELD XField(1:di,XDEX(j,i,k))
730	#include "transpose.code"
731	end select
732	return
733	end subroutine Transpose
734
735	subroutine reorder (MemoryOrder,MemO)
736	character() ,intent(in) :: MemoryOrder
737	character*3 ,intent(out) :: MemO
738	character*3 :: MemOrd
739	integer :: N,i,i1,i2,i3
740
741	MemO = MemoryOrder
742	N = len_trim(MemoryOrder)
743	if(N == 1) return
744	call lowercase(MemoryOrder,MemOrd)
745	! never invert the boundary codes
746	select case ( MemOrd )
747	case ( 'xsz','xez','ysz','yez' )
748	return
749	case default
750	continue
751	end select
752	i1 = 1
753	i3 = 1
754	do i=2,N
755	if(ichar(MemOrd(i:i)) < ichar(MemOrd(i1:i1))) I1 = i
756	if(ichar(MemOrd(i:i)) > ichar(MemOrd(i3:i3))) I3 = i
757	enddo
758	if(N == 2) then
759	i2=i3
760	else
761	i2 = 6-i1-i3
762	endif
763	MemO(1:1) = MemoryOrder(i1:i1)
764	MemO(2:2) = MemoryOrder(i2:i2)
765	if(N == 3) MemO(3:3) = MemoryOrder(i3:i3)
766	if(MemOrd(i1:i1) == 's' .or. MemOrd(i1:i1) == 'e') then
767	MemO(1:N-1) = MemO(2:N)
768	MemO(N:N ) = MemoryOrder(i1:i1)
769	endif
770	return
771	end subroutine reorder
772
773	! Returns .TRUE. iff it is OK to write time-independent domain metadata to the
774	! file referenced by DataHandle. If DataHandle is invalid, .FALSE. is
775	! returned.
776	LOGICAL FUNCTION ncd_ok_to_put_dom_ti( DataHandle )
777	USE wrf_data_pnc
778	include 'wrf_status_codes.h'
779	INTEGER, INTENT(IN) :: DataHandle
780	CHARACTER*80 :: fname
781	INTEGER :: filestate
782	INTEGER :: Status
783	LOGICAL :: dryrun, first_output, retval
784	call ext_pnc_inquire_filename( DataHandle, fname, filestate, Status )
785	IF ( Status /= WRF_NO_ERR ) THEN
786	write(msg,*) 'Warning Status = ',Status,' in ',__FILE__, &
787	', line', __LINE__
788	call wrf_debug ( WARN , TRIM(msg) )
789	retval = .FALSE.
790	ELSE
791	dryrun = ( filestate .EQ. WRF_FILE_OPENED_NOT_COMMITTED )
792	first_output = ncd_is_first_operation( DataHandle )
793	! retval = .NOT. dryrun .AND. first_output
794	retval = dryrun
795	ENDIF
796	ncd_ok_to_put_dom_ti = retval
797	RETURN
798	END FUNCTION ncd_ok_to_put_dom_ti
799
800	! Returns .TRUE. iff it is OK to read time-independent domain metadata from the
801	! file referenced by DataHandle. If DataHandle is invalid, .FALSE. is
802	! returned.
803	LOGICAL FUNCTION ncd_ok_to_get_dom_ti( DataHandle )
804	USE wrf_data_pnc
805	include 'wrf_status_codes.h'
806	INTEGER, INTENT(IN) :: DataHandle
807	CHARACTER*80 :: fname
808	INTEGER :: filestate
809	INTEGER :: Status
810	LOGICAL :: dryrun, retval
811	call ext_pnc_inquire_filename( DataHandle, fname, filestate, Status )
812	IF ( Status /= WRF_NO_ERR ) THEN
813	write(msg,*) 'Warning Status = ',Status,' in ',__FILE__, &
814	', line', __LINE__
815	call wrf_debug ( WARN , TRIM(msg) )
816	retval = .FALSE.
817	ELSE
818	dryrun = ( filestate .EQ. WRF_FILE_OPENED_NOT_COMMITTED )
819	retval = .NOT. dryrun
820	ENDIF
821	ncd_ok_to_get_dom_ti = retval
822	RETURN
823	END FUNCTION ncd_ok_to_get_dom_ti
824
825	! Returns .TRUE. iff nothing has been read from or written to the file
826	! referenced by DataHandle. If DataHandle is invalid, .FALSE. is returned.
827	LOGICAL FUNCTION ncd_is_first_operation( DataHandle )
828	USE wrf_data_pnc
829	INCLUDE 'wrf_status_codes.h'
830	INTEGER, INTENT(IN) :: DataHandle
831	TYPE(wrf_data_handle) ,POINTER :: DH
832	INTEGER :: Status
833	LOGICAL :: retval
834	CALL GetDH( DataHandle, DH, Status )
835	IF ( Status /= WRF_NO_ERR ) THEN
836	write(msg,*) 'Warning Status = ',Status,' in ',__FILE__, &
837	', line', __LINE__
838	call wrf_debug ( WARN , TRIM(msg) )
839	retval = .FALSE.
840	ELSE
841	retval = DH%first_operation
842	ENDIF
843	ncd_is_first_operation = retval
844	RETURN
845	END FUNCTION ncd_is_first_operation
846
847	end module ext_pnc_support_routines
848
849	subroutine ext_pnc_open_for_read(DatasetName, Comm1, Comm2, SysDepInfo, DataHandle, Status)
850	use wrf_data_pnc
851	use ext_pnc_support_routines
852	implicit none
853	include 'wrf_status_codes.h'
854	# include "pnetcdf.inc"
855	character (), INTENT(IN) :: DatasetName
856	integer , INTENT(IN) :: Comm1, Comm2
857	character (), INTENT(IN) :: SysDepInfo
858	integer , INTENT(OUT) :: DataHandle
859	integer , INTENT(OUT) :: Status
860	DataHandle = 0 ! dummy setting to quiet warning message
861	CALL ext_pnc_open_for_read_begin( DatasetName, Comm1, Comm2, SysDepInfo, DataHandle, Status )
862	IF ( Status .EQ. WRF_NO_ERR ) THEN
863	CALL ext_pnc_open_for_read_commit( DataHandle, Status )
864	ENDIF
865	return
866	end subroutine ext_pnc_open_for_read
867
868	!ends training phase; switches internal flag to enable input
869	!must be paired with call to ext_pnc_open_for_read_begin
870	subroutine ext_pnc_open_for_read_commit(DataHandle, Status)
871	use wrf_data_pnc
872	use ext_pnc_support_routines
873	implicit none
874	include 'wrf_status_codes.h'
875	# include "pnetcdf.inc"
876	integer, intent(in) :: DataHandle
877	integer, intent(out) :: Status
878	type(wrf_data_handle) ,pointer :: DH
879
880	if(WrfIOnotInitialized) then
881	Status = WRF_IO_NOT_INITIALIZED
882	write(msg,*) 'ext_pnc_ioinit was not called ',__FILE__,', line', __LINE__
883	call wrf_debug ( FATAL , msg)
884	return
885	endif
886	call GetDH(DataHandle,DH,Status)
887	if(Status /= WRF_NO_ERR) then
888	write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
889	call wrf_debug ( WARN , TRIM(msg))
890	return
891	endif
892	DH%FileStatus = WRF_FILE_OPENED_FOR_READ
893	DH%first_operation = .TRUE.
894	Status = WRF_NO_ERR
895	return
896	end subroutine ext_pnc_open_for_read_commit
897
898	subroutine ext_pnc_open_for_read_begin( FileName, Comm, IOComm, SysDepInfo, DataHandle, Status)
899	use wrf_data_pnc
900	use ext_pnc_support_routines
901	implicit none
902	include 'wrf_status_codes.h'
903	# include "pnetcdf.inc"
904	character() ,intent(IN) :: FileName
905	integer ,intent(IN) :: Comm
906	integer ,intent(IN) :: IOComm
907	character() ,intent(in) :: SysDepInfo
908	integer ,intent(out) :: DataHandle
909	integer ,intent(out) :: Status
910	type(wrf_data_handle) ,pointer :: DH
911	integer :: XType
912	integer :: stat
913	integer ,allocatable :: Buffer(:)
914	integer :: VarID
915	integer :: StoredDim
916	integer :: NAtts
917	integer :: DimIDs(2)
918	integer(KIND=MPI_OFFSET_KIND) :: VStart(2)
919	integer(KIND=MPI_OFFSET_KIND) :: VLen(2)
920	integer :: TotalNumVars
921	integer :: NumVars
922	integer :: i
923	character (NF_MAX_NAME) :: Name
924
925	if(WrfIOnotInitialized) then
926	Status = WRF_IO_NOT_INITIALIZED
927	write(msg,*) 'ext_pnc_ioinit was not called ',__FILE__,', line', __LINE__
928	call wrf_debug ( FATAL , msg)
929	return
930	endif
931	call allocHandle(DataHandle,DH,Comm,Status)
932	if(Status /= WRF_NO_ERR) then
933	write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
934	call wrf_debug ( WARN , TRIM(msg))
935	return
936	endif
937	stat = NFMPI_OPEN(Comm, FileName, NF_NOWRITE, MPI_INFO_NULL, DH%NCID)
938	call netcdf_err(stat,Status)
939	if(Status /= WRF_NO_ERR) then
940	write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
941	call wrf_debug ( WARN , TRIM(msg))
942	return
943	endif
944	stat = NFMPI_INQ_VARID(DH%NCID,DH%TimesName,VarID)
945	call netcdf_err(stat,Status)
946	if(Status /= WRF_NO_ERR) then
947	write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
948	call wrf_debug ( WARN , TRIM(msg))
949	return
950	endif
951	stat = NFMPI_INQ_VAR(DH%NCID,VarID,DH%TimesName, XType, StoredDim, DimIDs, NAtts)
952	call netcdf_err(stat,Status)
953	if(Status /= WRF_NO_ERR) then
954	write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
955	call wrf_debug ( WARN , TRIM(msg))
956	return
957	endif
958	if(XType/=NF_CHAR) then
959	Status = WRF_WARN_TYPE_MISMATCH
960	write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
961	call wrf_debug ( WARN , TRIM(msg))
962	return
963	endif
964	stat = NFMPI_INQ_DIMLEN(DH%NCID,DimIDs(1),VLen(1))
965	call netcdf_err(stat,Status)
966	if(Status /= WRF_NO_ERR) then
967	write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
968	call wrf_debug ( WARN , TRIM(msg))
969	return
970	endif
971	if(VLen(1) /= DateStrLen) then
972	Status = WRF_WARN_DATESTR_BAD_LENGTH
973	write(msg,*) 'Warning DATESTR BAD LENGTH in ',__FILE__,', line', __LINE__
974	call wrf_debug ( WARN , TRIM(msg))
975	return
976	endif
977	stat = NFMPI_INQ_DIMLEN(DH%NCID,DimIDs(2),VLen(2))
978	call netcdf_err(stat,Status)
979	if(Status /= WRF_NO_ERR) then
980	write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
981	call wrf_debug ( WARN , TRIM(msg))
982	return
983	endif
984	if(VLen(2) > MaxTimes) then
985	Status = WRF_ERR_FATAL_TOO_MANY_TIMES
986	write(msg,*) 'Fatal TOO MANY TIME VALUES in ',__FILE__,', line', __LINE__
987	call wrf_debug ( FATAL , TRIM(msg))
988	return
989	endif
990	VStart(1) = 1
991	VStart(2) = 1
992	stat = NFMPI_GET_VARA_TEXT_ALL(DH%NCID,VarID,VStart,VLen,DH%Times)
993	call netcdf_err(stat,Status)
994	if(Status /= WRF_NO_ERR) then
995	write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
996	call wrf_debug ( WARN , TRIM(msg))
997	return
998	endif
999	stat = NFMPI_INQ_NVARS(DH%NCID,TotalNumVars)
1000	call netcdf_err(stat,Status)
1001	if(Status /= WRF_NO_ERR) then
1002	write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
1003	call wrf_debug ( WARN , TRIM(msg))
1004	return
1005	endif
1006	NumVars = 0
1007	do i=1,TotalNumVars
1008	stat = NFMPI_INQ_VARNAME(DH%NCID,i,Name)
1009	call netcdf_err(stat,Status)
1010	if(Status /= WRF_NO_ERR) then
1011	write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
1012	call wrf_debug ( WARN , TRIM(msg))
1013	return
1014	elseif(Name(1:5) /= 'md___' .and. Name /= DH%TimesName) then
1015	NumVars = NumVars+1
1016	DH%VarNames(NumVars) = Name
1017	DH%VarIDs(NumVars) = i
1018	endif
1019	enddo
1020	DH%NumVars = NumVars
1021	DH%NumberTimes = VLen(2)
1022	DH%FileStatus = WRF_FILE_OPENED_NOT_COMMITTED
1023	DH%FileName = FileName
1024	DH%CurrentVariable = 0
1025	DH%CurrentTime = 0
1026	DH%TimesVarID = VarID
1027	DH%TimeIndex = 0
1028	return
1029	end subroutine ext_pnc_open_for_read_begin
1030
1031	subroutine ext_pnc_open_for_update( FileName, Comm, IOComm, SysDepInfo, DataHandle, Status)
1032	use wrf_data_pnc
1033	use ext_pnc_support_routines
1034	implicit none
1035	include 'wrf_status_codes.h'
1036	# include "pnetcdf.inc"
1037	character() ,intent(IN) :: FileName
1038	integer ,intent(IN) :: Comm
1039	integer ,intent(IN) :: IOComm
1040	character() ,intent(in) :: SysDepInfo
1041	integer ,intent(out) :: DataHandle
1042	integer ,intent(out) :: Status
1043	type(wrf_data_handle) ,pointer :: DH
1044	integer :: XType
1045	integer :: stat
1046	integer ,allocatable :: Buffer(:)
1047	integer :: VarID
1048	integer :: StoredDim
1049	integer :: NAtts
1050	integer :: DimIDs(2)
1051	integer :: VStart(2)
1052	integer :: VLen(2)
1053	integer :: TotalNumVars
1054	integer :: NumVars
1055	integer :: i
1056	character (NF_MAX_NAME) :: Name
1057
1058	if(WrfIOnotInitialized) then
1059	Status = WRF_IO_NOT_INITIALIZED
1060	write(msg,*) 'ext_pnc_ioinit was not called ',__FILE__,', line', __LINE__
1061	call wrf_debug ( FATAL , msg)
1062	return
1063	endif
1064	call allocHandle(DataHandle,DH,Comm,Status)
1065	if(Status /= WRF_NO_ERR) then
1066	write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
1067	call wrf_debug ( WARN , TRIM(msg))
1068	return
1069	endif
1070	stat = NFMPI_OPEN(Comm, FileName, NF_WRITE, MPI_INFO_NULL, DH%NCID)
1071	call netcdf_err(stat,Status)
1072	if(Status /= WRF_NO_ERR) then
1073	write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
1074	call wrf_debug ( WARN , TRIM(msg))
1075	return
1076	endif
1077	stat = NFMPI_INQ_VARID(DH%NCID,DH%TimesName,VarID)
1078	call netcdf_err(stat,Status)
1079	if(Status /= WRF_NO_ERR) then
1080	write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
1081	call wrf_debug ( WARN , TRIM(msg))
1082	return
1083	endif
1084	stat = NFMPI_INQ_VAR(DH%NCID,VarID,DH%TimesName, XType, StoredDim, DimIDs, NAtts)
1085	call netcdf_err(stat,Status)
1086	if(Status /= WRF_NO_ERR) then
1087	write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
1088	call wrf_debug ( WARN , TRIM(msg))
1089	return
1090	endif
1091	if(XType/=NF_CHAR) then
1092	Status = WRF_WARN_TYPE_MISMATCH
1093	write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
1094	call wrf_debug ( WARN , TRIM(msg))
1095	return
1096	endif
1097	stat = NFMPI_INQ_DIMLEN(DH%NCID,DimIDs(1),VLen(1))
1098	call netcdf_err(stat,Status)
1099	if(Status /= WRF_NO_ERR) then
1100	write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
1101	call wrf_debug ( WARN , TRIM(msg))
1102	return
1103	endif
1104	if(VLen(1) /= DateStrLen) then
1105	Status = WRF_WARN_DATESTR_BAD_LENGTH
1106	write(msg,*) 'Warning DATESTR BAD LENGTH in ',__FILE__,', line', __LINE__
1107	call wrf_debug ( WARN , TRIM(msg))
1108	return
1109	endif
1110	stat = NFMPI_INQ_DIMLEN(DH%NCID,DimIDs(2),VLen(2))
1111	call netcdf_err(stat,Status)
1112	if(Status /= WRF_NO_ERR) then
1113	write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
1114	call wrf_debug ( WARN , TRIM(msg))
1115	return
1116	endif
1117	if(VLen(2) > MaxTimes) then
1118	Status = WRF_ERR_FATAL_TOO_MANY_TIMES
1119	write(msg,*) 'Fatal TOO MANY TIME VALUES in ',__FILE__,', line', __LINE__
1120	call wrf_debug ( FATAL , TRIM(msg))
1121	return
1122	endif
1123	VStart(1) = 1
1124	VStart(2) = 1
1125	stat = NFMPI_GET_VARA_TEXT_ALL(DH%NCID,VarID,VStart,VLen,DH%Times)
1126	call netcdf_err(stat,Status)
1127	if(Status /= WRF_NO_ERR) then
1128	write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
1129	call wrf_debug ( WARN , TRIM(msg))
1130	return
1131	endif
1132	stat = NFMPI_INQ_NVARS(DH%NCID,TotalNumVars)
1133	call netcdf_err(stat,Status)
1134	if(Status /= WRF_NO_ERR) then
1135	write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
1136	call wrf_debug ( WARN , TRIM(msg))
1137	return
1138	endif
1139	NumVars = 0
1140	do i=1,TotalNumVars
1141	stat = NFMPI_INQ_VARNAME(DH%NCID,i,Name)
1142	call netcdf_err(stat,Status)
1143	if(Status /= WRF_NO_ERR) then
1144	write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
1145	call wrf_debug ( WARN , TRIM(msg))
1146	return
1147	elseif(Name(1:5) /= 'md___' .and. Name /= DH%TimesName) then
1148	NumVars = NumVars+1
1149	DH%VarNames(NumVars) = Name
1150	DH%VarIDs(NumVars) = i
1151	endif
1152	enddo
1153	DH%NumVars = NumVars
1154	DH%NumberTimes = VLen(2)
1155	DH%FileStatus = WRF_FILE_OPENED_FOR_UPDATE
1156	DH%FileName = FileName
1157	DH%CurrentVariable = 0
1158	DH%CurrentTime = 0
1159	DH%TimesVarID = VarID
1160	DH%TimeIndex = 0
1161	return
1162	end subroutine ext_pnc_open_for_update
1163
1164
1165	SUBROUTINE ext_pnc_open_for_write_begin(FileName,Comm,IOComm,SysDepInfo,DataHandle,Status)
1166	use wrf_data_pnc
1167	use ext_pnc_support_routines
1168	implicit none
1169	include 'wrf_status_codes.h'
1170	# include "pnetcdf.inc"
1171	character() ,intent(in) :: FileName
1172	integer ,intent(in) :: Comm
1173	integer ,intent(in) :: IOComm
1174	character() ,intent(in) :: SysDepInfo
1175	integer ,intent(out) :: DataHandle
1176	integer ,intent(out) :: Status
1177	type(wrf_data_handle),pointer :: DH
1178	integer :: i
1179	integer :: stat
1180	character (7) :: Buffer
1181	integer :: VDimIDs(2)
1182
1183	if(WrfIOnotInitialized) then
1184	Status = WRF_IO_NOT_INITIALIZED
1185	write(msg,*) 'ext_pnc_open_for_write_begin: ext_pnc_ioinit was not called ',__FILE__,', line', __LINE__
1186	call wrf_debug ( FATAL , msg)
1187	return
1188	endif
1189	call allocHandle(DataHandle,DH,Comm,Status)
1190	if(Status /= WRF_NO_ERR) then
1191	write(msg,*) 'Fatal ALLOCATION ERROR in ext_pnc_open_for_write_begin ',__FILE__,', line', __LINE__
1192	call wrf_debug ( FATAL , TRIM(msg))
1193	return
1194	endif
1195	DH%TimeIndex = 0
1196	DH%Times = ZeroDate
1197	! stat = NFMPI_CREATE(Comm, FileName, NF_CLOBBER, MPI_INFO_NULL, DH%NCID)
1198	stat = NFMPI_CREATE(Comm, FileName, IOR(NF_CLOBBER, NF_64BIT_OFFSET), MPI_INFO_NULL, DH%NCID)
1199	call netcdf_err(stat,Status)
1200	if(Status /= WRF_NO_ERR) then
1201	write(msg,*) 'NetCDF error in ext_pnc_open_for_write_begin ',__FILE__,', line', __LINE__
1202	call wrf_debug ( WARN , TRIM(msg))
1203	return
1204	endif
1205	DH%FileStatus = WRF_FILE_OPENED_NOT_COMMITTED
1206	DH%FileName = FileName
1207	stat = NFMPI_DEF_DIM(DH%NCID,DH%DimUnlimName,i2offset(NF_UNLIMITED),DH%DimUnlimID)
1208	call netcdf_err(stat,Status)
1209	if(Status /= WRF_NO_ERR) then
1210	write(msg,*) 'NetCDF error in ext_pnc_open_for_write_begin ',__FILE__,', line', __LINE__
1211	call wrf_debug ( WARN , TRIM(msg))
1212	return
1213	endif
1214	DH%VarNames (1:MaxVars) = NO_NAME
1215	DH%MDVarNames(1:MaxVars) = NO_NAME
1216	do i=1,MaxDims
1217	write(Buffer,FMT="('DIM',i4.4)") i
1218	DH%DimNames (i) = Buffer
1219	DH%DimLengths(i) = NO_DIM
1220	enddo
1221	DH%DimNames(1) = 'DateStrLen'
1222	stat = NFMPI_DEF_DIM(DH%NCID,DH%DimNames(1),i2offset(DateStrLen),DH%DimIDs(1))
1223	call netcdf_err(stat,Status)
1224	if(Status /= WRF_NO_ERR) then
1225	write(msg,*) 'NetCDF error in ext_pnc_open_for_write_begin ',__FILE__,', line', __LINE__
1226	call wrf_debug ( WARN , TRIM(msg))
1227	return
1228	endif
1229	VDimIDs(1) = DH%DimIDs(1)
1230	VDimIDs(2) = DH%DimUnlimID
1231	stat = NFMPI_DEF_VAR(DH%NCID,DH%TimesName,NF_CHAR,2,VDimIDs,DH%TimesVarID)
1232	call netcdf_err(stat,Status)
1233	if(Status /= WRF_NO_ERR) then
1234	write(msg,*) 'NetCDF error in ext_pnc_open_for_write_begin ',__FILE__,', line', __LINE__
1235	call wrf_debug ( WARN , TRIM(msg))
1236	return
1237	endif
1238	DH%DimLengths(1) = DateStrLen
1239	return
1240	end subroutine ext_pnc_open_for_write_begin
1241
1242	!stub
1243	!opens a file for writing or coupler datastream for sending messages.
1244	!no training phase for this version of the open stmt.
1245	subroutine ext_pnc_open_for_write (DatasetName, Comm1, Comm2, &
1246	SysDepInfo, DataHandle, Status)
1247	use wrf_data_pnc
1248	use ext_pnc_support_routines
1249	implicit none
1250	include 'wrf_status_codes.h'
1251	# include "pnetcdf.inc"
1252	character (), intent(in) ::DatasetName
1253	integer , intent(in) ::Comm1, Comm2
1254	character (), intent(in) ::SysDepInfo
1255	integer , intent(out) :: DataHandle
1256	integer , intent(out) :: Status
1257	Status=WRF_WARN_NOOP
1258	DataHandle = 0 ! dummy setting to quiet warning message
1259	return
1260	end subroutine ext_pnc_open_for_write
1261
1262	SUBROUTINE ext_pnc_open_for_write_commit(DataHandle, Status)
1263	use wrf_data_pnc
1264	use ext_pnc_support_routines
1265	implicit none
1266	include 'wrf_status_codes.h'
1267	# include "pnetcdf.inc"
1268	integer ,intent(in) :: DataHandle
1269	integer ,intent(out) :: Status
1270	type(wrf_data_handle),pointer :: DH
1271	integer :: i
1272	integer :: stat
1273
1274	if(WrfIOnotInitialized) then
1275	Status = WRF_IO_NOT_INITIALIZED
1276	write(msg,*) 'ext_pnc_open_for_write_commit: ext_pnc_ioinit was not called ',__FILE__,', line', __LINE__
1277	call wrf_debug ( FATAL , msg)
1278	return
1279	endif
1280	call GetDH(DataHandle,DH,Status)
1281	if(Status /= WRF_NO_ERR) then
1282	write(msg,*) 'Warning Status = ',Status,' in ext_pnc_open_for_write_commit ',__FILE__,', line', __LINE__
1283	call wrf_debug ( WARN , TRIM(msg))
1284	return
1285	endif
1286	stat = NFMPI_ENDDEF(DH%NCID)
1287	call netcdf_err(stat,Status)
1288	if(Status /= WRF_NO_ERR) then
1289	write(msg,*) 'NetCDF error in ext_pnc_open_for_write_commit ',__FILE__,', line', __LINE__
1290	call wrf_debug ( WARN , TRIM(msg))
1291	return
1292	endif
1293	DH%FileStatus = WRF_FILE_OPENED_FOR_WRITE
1294	DH%first_operation = .TRUE.
1295	return
1296	end subroutine ext_pnc_open_for_write_commit
1297
1298	subroutine ext_pnc_ioclose(DataHandle, Status)
1299	use wrf_data_pnc
1300	use ext_pnc_support_routines
1301	implicit none
1302	include 'wrf_status_codes.h'
1303	# include "pnetcdf.inc"
1304	integer ,intent(in) :: DataHandle
1305	integer ,intent(out) :: Status
1306	type(wrf_data_handle),pointer :: DH
1307	integer :: stat
1308
1309	call GetDH(DataHandle,DH,Status)
1310	if(Status /= WRF_NO_ERR) then
1311	write(msg,*) 'Warning Status = ',Status,' in ext_pnc_ioclose ',__FILE__,', line', __LINE__
1312	call wrf_debug ( WARN , TRIM(msg))
1313	return
1314	endif
1315	if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
1316	Status = WRF_WARN_FILE_NOT_OPENED
1317	write(msg,*) 'Warning FILE NOT OPENED in ext_pnc_ioclose ',__FILE__,', line', __LINE__
1318	call wrf_debug ( WARN , TRIM(msg))
1319	elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
1320	Status = WRF_WARN_DRYRUN_CLOSE
1321	write(msg,*) 'Warning TRY TO CLOSE DRYRUN in ext_pnc_ioclose ',__FILE__,', line', __LINE__
1322	call wrf_debug ( WARN , TRIM(msg))
1323	elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
1324	continue
1325	elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
1326	continue
1327	elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_UPDATE) then
1328	continue
1329	else
1330	Status = WRF_ERR_FATAL_BAD_FILE_STATUS
1331	write(msg,*) 'Fatal error BAD FILE STATUS in ext_pnc_ioclose ',__FILE__,', line', __LINE__
1332	call wrf_debug ( FATAL , TRIM(msg))
1333	return
1334	endif
1335
1336	stat = NFMPI_CLOSE(DH%NCID)
1337	call netcdf_err(stat,Status)
1338	if(Status /= WRF_NO_ERR) then
1339	write(msg,*) 'NetCDF error in ext_pnc_ioclose ',__FILE__,', line', __LINE__
1340	call wrf_debug ( WARN , TRIM(msg))
1341	return
1342	endif
1343	CALL deallocHandle( DataHandle, Status )
1344	DH%Free=.true.
1345	return
1346	end subroutine ext_pnc_ioclose
1347
1348	subroutine ext_pnc_iosync( DataHandle, Status)
1349	use wrf_data_pnc
1350	use ext_pnc_support_routines
1351	implicit none
1352	include 'wrf_status_codes.h'
1353	# include "pnetcdf.inc"
1354	integer ,intent(in) :: DataHandle
1355	integer ,intent(out) :: Status
1356	type(wrf_data_handle),pointer :: DH
1357	integer :: stat
1358
1359	call GetDH(DataHandle,DH,Status)
1360	if(Status /= WRF_NO_ERR) then
1361	write(msg,*) 'Warning Status = ',Status,' in ext_pnc_iosync ',__FILE__,', line', __LINE__
1362	call wrf_debug ( WARN , TRIM(msg))
1363	return
1364	endif
1365	if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
1366	Status = WRF_WARN_FILE_NOT_OPENED
1367	write(msg,*) 'Warning FILE NOT OPENED in ext_pnc_iosync ',__FILE__,', line', __LINE__
1368	call wrf_debug ( WARN , TRIM(msg))
1369	elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
1370	Status = WRF_WARN_FILE_NOT_COMMITTED
1371	write(msg,*) 'Warning FILE NOT COMMITTED in ext_pnc_iosync ',__FILE__,', line', __LINE__
1372	call wrf_debug ( WARN , TRIM(msg))
1373	elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
1374	continue
1375	elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
1376	continue
1377	else
1378	Status = WRF_ERR_FATAL_BAD_FILE_STATUS
1379	write(msg,*) 'Fatal error BAD FILE STATUS in ext_pnc_iosync ',__FILE__,', line', __LINE__
1380	call wrf_debug ( FATAL , TRIM(msg))
1381	return
1382	endif
1383	stat = NFMPI_SYNC(DH%NCID)
1384	call netcdf_err(stat,Status)
1385	if(Status /= WRF_NO_ERR) then
1386	write(msg,*) 'NetCDF error in ext_pnc_iosync ',__FILE__,', line', __LINE__
1387	call wrf_debug ( WARN , TRIM(msg))
1388	return
1389	endif
1390	return
1391	end subroutine ext_pnc_iosync
1392
1393
1394
1395	subroutine ext_pnc_redef( DataHandle, Status)
1396	use wrf_data_pnc
1397	use ext_pnc_support_routines
1398	implicit none
1399	include 'wrf_status_codes.h'
1400	# include "pnetcdf.inc"
1401	integer ,intent(in) :: DataHandle
1402	integer ,intent(out) :: Status
1403	type(wrf_data_handle),pointer :: DH
1404	integer :: stat
1405
1406	call GetDH(DataHandle,DH,Status)
1407	if(Status /= WRF_NO_ERR) then
1408	write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
1409	call wrf_debug ( WARN , TRIM(msg))
1410	return
1411	endif
1412	if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
1413	Status = WRF_WARN_FILE_NOT_OPENED
1414	write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
1415	call wrf_debug ( WARN , TRIM(msg))
1416	elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
1417	Status = WRF_WARN_FILE_NOT_COMMITTED
1418	write(msg,*) 'Warning FILE NOT COMMITTED in ',__FILE__,', line', __LINE__
1419	call wrf_debug ( WARN , TRIM(msg))
1420	elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
1421	continue
1422	elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
1423	Status = WRF_WARN_FILE_OPEN_FOR_READ
1424	write(msg,*) 'Warning FILE OPEN FOR READ in ',__FILE__,', line', __LINE__
1425	call wrf_debug ( WARN , TRIM(msg))
1426	else
1427	Status = WRF_ERR_FATAL_BAD_FILE_STATUS
1428	write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
1429	call wrf_debug ( FATAL , TRIM(msg))
1430	return
1431	endif
1432	stat = NFMPI_REDEF(DH%NCID)
1433	call netcdf_err(stat,Status)
1434	if(Status /= WRF_NO_ERR) then
1435	write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
1436	call wrf_debug ( WARN , TRIM(msg))
1437	return
1438	endif
1439	DH%FileStatus = WRF_FILE_OPENED_NOT_COMMITTED
1440	return
1441	end subroutine ext_pnc_redef
1442
1443	subroutine ext_pnc_enddef( DataHandle, Status)
1444	use wrf_data_pnc
1445	use ext_pnc_support_routines
1446	implicit none
1447	include 'wrf_status_codes.h'
1448	# include "pnetcdf.inc"
1449	integer ,intent(in) :: DataHandle
1450	integer ,intent(out) :: Status
1451	type(wrf_data_handle),pointer :: DH
1452	integer :: stat
1453
1454	call GetDH(DataHandle,DH,Status)
1455	if(Status /= WRF_NO_ERR) then
1456	write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
1457	call wrf_debug ( WARN , TRIM(msg))
1458	return
1459	endif
1460	if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
1461	Status = WRF_WARN_FILE_NOT_OPENED
1462	write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
1463	call wrf_debug ( WARN , TRIM(msg))
1464	elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
1465	Status = WRF_WARN_FILE_NOT_COMMITTED
1466	write(msg,*) 'Warning FILE NOT COMMITTED in ',__FILE__,', line', __LINE__
1467	call wrf_debug ( WARN , TRIM(msg))
1468	elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
1469	continue
1470	elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
1471	Status = WRF_WARN_FILE_OPEN_FOR_READ
1472	write(msg,*) 'Warning FILE OPEN FOR READ in ',__FILE__,', line', __LINE__
1473	call wrf_debug ( WARN , TRIM(msg))
1474	else
1475	Status = WRF_ERR_FATAL_BAD_FILE_STATUS
1476	write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
1477	call wrf_debug ( FATAL , TRIM(msg))
1478	return
1479	endif
1480	stat = NFMPI_ENDDEF(DH%NCID)
1481	call netcdf_err(stat,Status)
1482	if(Status /= WRF_NO_ERR) then
1483	write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
1484	call wrf_debug ( WARN , TRIM(msg))
1485	return
1486	endif
1487	DH%FileStatus = WRF_FILE_OPENED_FOR_WRITE
1488	return
1489	end subroutine ext_pnc_enddef
1490
1491	subroutine ext_pnc_ioinit(SysDepInfo, Status)
1492	use wrf_data_pnc
1493	implicit none
1494	include 'wrf_status_codes.h'
1495	CHARACTER(), INTENT(IN) :: SysDepInfo
1496	INTEGER ,INTENT(INOUT) :: Status
1497
1498	WrfIOnotInitialized = .false.
1499	WrfDataHandles(1:WrfDataHandleMax)%Free = .true.
1500	WrfDataHandles(1:WrfDataHandleMax)%TimesName = 'Times'
1501	WrfDataHandles(1:WrfDataHandleMax)%DimUnlimName = 'Time'
1502	WrfDataHandles(1:WrfDataHandleMax)%FileStatus = WRF_FILE_NOT_OPENED
1503	Status = WRF_NO_ERR
1504	return
1505	end subroutine ext_pnc_ioinit
1506
1507
1508	subroutine ext_pnc_inquiry (Inquiry, Result, Status)
1509	use wrf_data_pnc
1510	implicit none
1511	include 'wrf_status_codes.h'
1512	character (), INTENT(IN) :: Inquiry
1513	character (), INTENT(OUT) :: Result
1514	integer ,INTENT(INOUT) :: Status
1515	SELECT CASE (Inquiry)
1516	CASE ("RANDOM_WRITE","RANDOM_READ","SEQUENTIAL_WRITE","SEQUENTIAL_READ")
1517	Result='ALLOW'
1518	CASE ("OPEN_READ","OPEN_COMMIT_WRITE")
1519	Result='REQUIRE'
1520	CASE ("OPEN_WRITE","OPEN_COMMIT_READ","PARALLEL_IO")
1521	Result='NO'
1522	CASE ("SELF_DESCRIBING","SUPPORT_METADATA","SUPPORT_3D_FIELDS")
1523	Result='YES'
1524	CASE ("MEDIUM")
1525	Result ='FILE'
1526	CASE DEFAULT
1527	Result = 'No Result for that inquiry!'
1528	END SELECT
1529	Status=WRF_NO_ERR
1530	return
1531	end subroutine ext_pnc_inquiry
1532
1533
1534
1535
1536	subroutine ext_pnc_ioexit(Status)
1537	use wrf_data_pnc
1538	use ext_pnc_support_routines
1539	implicit none
1540	include 'wrf_status_codes.h'
1541	# include "pnetcdf.inc"
1542	integer , INTENT(INOUT) ::Status
1543	integer :: error
1544	type(wrf_data_handle),pointer :: DH
1545	integer :: i
1546	integer :: stat
1547	if(WrfIOnotInitialized) then
1548	Status = WRF_IO_NOT_INITIALIZED
1549	write(msg,*) 'ext_pnc_ioinit was not called ',__FILE__,', line', __LINE__
1550	call wrf_debug ( FATAL , msg)
1551	return
1552	endif
1553	do i=1,WrfDataHandleMax
1554	CALL deallocHandle( i , stat )
1555	enddo
1556	return
1557	end subroutine ext_pnc_ioexit
1558
1559	subroutine ext_pnc_get_dom_ti_real(DataHandle,Element,Data,Count,OutCount,Status)
1560	#define ROUTINE_TYPE 'REAL'
1561	#define TYPE_DATA real,intent(out) :: Data(*)
1562	#define TYPE_COUNT integer,intent(in) :: Count
1563	#define TYPE_OUTCOUNT integer,intent(out) :: OutCOunt
1564	#define TYPE_BUFFER real,allocatable :: Buffer(:)
1565	#define NF_TYPE NF_FLOAT
1566	#define NF_ROUTINE NFMPI_GET_ATT_REAL
1567	#define COPY Data(1:min(Len,Count)) = Buffer(1:min(Len,Count))
1568	#include "ext_pnc_get_dom_ti.code"
1569	end subroutine ext_pnc_get_dom_ti_real
1570
1571	subroutine ext_pnc_get_dom_ti_integer(DataHandle,Element,Data,Count,OutCount,Status)
1572	#undef ROUTINE_TYPE
1573	#undef TYPE_DATA
1574	#undef TYPE_BUFFER
1575	#undef NF_TYPE
1576	#undef NF_ROUTINE
1577	#undef COPY
1578	#define ROUTINE_TYPE 'INTEGER'
1579	#define TYPE_DATA integer,intent(out) :: Data(*)
1580	#define TYPE_BUFFER integer,allocatable :: Buffer(:)
1581	#define NF_TYPE NF_INT
1582	#define NF_ROUTINE NFMPI_GET_ATT_INT
1583	#define COPY Data(1:min(Len,Count)) = Buffer(1:min(Len,Count))
1584	#include "ext_pnc_get_dom_ti.code"
1585	end subroutine ext_pnc_get_dom_ti_integer
1586
1587	subroutine ext_pnc_get_dom_ti_double(DataHandle,Element,Data,Count,OutCount,Status)
1588	#undef ROUTINE_TYPE
1589	#undef TYPE_DATA
1590	#undef TYPE_BUFFER
1591	#undef NF_TYPE
1592	#undef NF_ROUTINE
1593	#undef COPY
1594	#define ROUTINE_TYPE 'DOUBLE'
1595	#define TYPE_DATA real8,intent(out) :: Data()
1596	#define TYPE_BUFFER real*8,allocatable :: Buffer(:)
1597	#define NF_TYPE NF_DOUBLE
1598	#define NF_ROUTINE NFMPI_GET_ATT_DOUBLE
1599	#define COPY Data(1:min(Len,Count)) = Buffer(1:min(Len,Count))
1600	#include "ext_pnc_get_dom_ti.code"
1601	end subroutine ext_pnc_get_dom_ti_double
1602
1603	subroutine ext_pnc_get_dom_ti_logical(DataHandle,Element,Data,Count,OutCount,Status)
1604	#undef ROUTINE_TYPE
1605	#undef TYPE_DATA
1606	#undef TYPE_BUFFER
1607	#undef NF_TYPE
1608	#undef NF_ROUTINE
1609	#undef COPY
1610	#define ROUTINE_TYPE 'LOGICAL'
1611	#define TYPE_DATA logical,intent(out) :: Data(*)
1612	#define TYPE_BUFFER integer,allocatable :: Buffer(:)
1613	#define NF_TYPE NF_INT
1614	#define NF_ROUTINE NFMPI_GET_ATT_INT
1615	#define COPY Data(1:min(Len,Count)) = Buffer(1:min(Len,Count))==1
1616	#include "ext_pnc_get_dom_ti.code"
1617	end subroutine ext_pnc_get_dom_ti_logical
1618
1619	subroutine ext_pnc_get_dom_ti_char(DataHandle,Element,Data,Status)
1620	#undef ROUTINE_TYPE
1621	#undef TYPE_DATA
1622	#undef TYPE_COUNT
1623	#undef TYPE_OUTCOUNT
1624	#undef TYPE_BUFFER
1625	#undef NF_TYPE
1626	#define ROUTINE_TYPE 'CHAR'
1627	#define TYPE_DATA character(),intent(out) :: Data
1628	#define TYPE_COUNT
1629	#define TYPE_OUTCOUNT
1630	#define TYPE_BUFFER
1631	#define NF_TYPE NF_CHAR
1632	#define CHAR_TYPE
1633	#include "ext_pnc_get_dom_ti.code"
1634	#undef CHAR_TYPE
1635	end subroutine ext_pnc_get_dom_ti_char
1636
1637	subroutine ext_pnc_put_dom_ti_real(DataHandle,Element,Data,Count,Status)
1638	#undef ROUTINE_TYPE
1639	#undef TYPE_DATA
1640	#undef TYPE_COUNT
1641	#undef NF_ROUTINE
1642	#undef ARGS
1643	#undef LOG
1644	#define ROUTINE_TYPE 'REAL'
1645	#define TYPE_DATA real ,intent(in) :: Data(*)
1646	#define TYPE_COUNT integer,intent(in) :: Count
1647	#define NF_ROUTINE NFMPI_PUT_ATT_REAL
1648	#define ARGS NF_FLOAT,i2offset(Count),Data
1649	#include "ext_pnc_put_dom_ti.code"
1650	end subroutine ext_pnc_put_dom_ti_real
1651
1652	subroutine ext_pnc_put_dom_ti_integer(DataHandle,Element,Data,Count,Status)
1653	#undef ROUTINE_TYPE
1654	#undef TYPE_DATA
1655	#undef TYPE_COUNT
1656	#undef NF_ROUTINE
1657	#undef ARGS
1658	#undef LOG
1659	#define ROUTINE_TYPE 'INTEGER'
1660	#define TYPE_DATA integer,intent(in) :: Data(*)
1661	#define TYPE_COUNT integer,intent(in) :: Count
1662	#define NF_ROUTINE NFMPI_PUT_ATT_INT
1663	#define ARGS NF_INT,i2offset(Count),Data
1664	#include "ext_pnc_put_dom_ti.code"
1665	end subroutine ext_pnc_put_dom_ti_integer
1666
1667	subroutine ext_pnc_put_dom_ti_double(DataHandle,Element,Data,Count,Status)
1668	#undef ROUTINE_TYPE
1669	#undef TYPE_DATA
1670	#undef TYPE_COUNT
1671	#undef NF_ROUTINE
1672	#undef ARGS
1673	#undef LOG
1674	#define ROUTINE_TYPE 'DOUBLE'
1675	#define TYPE_DATA real8 ,intent(in) :: Data()
1676	#define TYPE_COUNT integer,intent(in) :: Count
1677	#define NF_ROUTINE NFMPI_PUT_ATT_DOUBLE
1678	#define ARGS NF_DOUBLE,i2offset(Count),Data
1679	#include "ext_pnc_put_dom_ti.code"
1680	end subroutine ext_pnc_put_dom_ti_double
1681
1682	subroutine ext_pnc_put_dom_ti_logical(DataHandle,Element,Data,Count,Status)
1683	#undef ROUTINE_TYPE
1684	#undef TYPE_DATA
1685	#undef TYPE_COUNT
1686	#undef NF_ROUTINE
1687	#undef ARGS
1688	#define ROUTINE_TYPE 'LOGICAL'
1689	#define TYPE_DATA logical,intent(in) :: Data(*)
1690	#define TYPE_COUNT integer,intent(in) :: Count
1691	#define NF_ROUTINE NFMPI_PUT_ATT_INT
1692	#define ARGS NF_INT,i2offset(Count),Buffer
1693	#define LOG
1694	#include "ext_pnc_put_dom_ti.code"
1695	end subroutine ext_pnc_put_dom_ti_logical
1696
1697	subroutine ext_pnc_put_dom_ti_char(DataHandle,Element,Data,Status)
1698	#undef ROUTINE_TYPE
1699	#undef TYPE_DATA
1700	#undef TYPE_COUNT
1701	#undef NF_ROUTINE
1702	#undef ARGS
1703	#undef LOG
1704	#define ROUTINE_TYPE 'CHAR'
1705	#define TYPE_DATA character(),intent(in) :: Data
1706	#define TYPE_COUNT integer,parameter :: Count=1
1707	#define NF_ROUTINE NFMPI_PUT_ATT_TEXT
1708	#define ARGS i2offset(len_trim(Data)),Data
1709	#include "ext_pnc_put_dom_ti.code"
1710	end subroutine ext_pnc_put_dom_ti_char
1711
1712	subroutine ext_pnc_put_var_ti_real(DataHandle,Element,Var,Data,Count,Status)
1713	#undef ROUTINE_TYPE
1714	#undef TYPE_DATA
1715	#undef TYPE_COUNT
1716	#undef NF_ROUTINE
1717	#undef ARGS
1718	#undef LOG
1719	#define ROUTINE_TYPE 'REAL'
1720	#define TYPE_DATA real ,intent(in) :: Data(*)
1721	#define TYPE_COUNT integer ,intent(in) :: Count
1722	#define NF_ROUTINE NFMPI_PUT_ATT_REAL
1723	#define ARGS NF_FLOAT,i2offset(Count),Data
1724	#include "ext_pnc_put_var_ti.code"
1725	end subroutine ext_pnc_put_var_ti_real
1726
1727	subroutine ext_pnc_put_var_td_real(DataHandle,Element,DateStr,Var,Data,Count,Status)
1728	#undef ROUTINE_TYPE
1729	#undef TYPE_DATA
1730	#undef TYPE_COUNT
1731	#undef NF_ROUTINE
1732	#undef NF_TYPE
1733	#undef LENGTH
1734	#undef ARG
1735	#undef LOG
1736	#define ROUTINE_TYPE 'REAL'
1737	#define TYPE_DATA real ,intent(in) :: Data(*)
1738	#define TYPE_COUNT integer ,intent(in) :: Count
1739	#define NF_ROUTINE NFMPI_PUT_VARA_REAL_ALL
1740	#define NF_TYPE NF_FLOAT
1741	#define LENGTH Count
1742	#define ARG
1743	#include "ext_pnc_put_var_td.code"
1744	end subroutine ext_pnc_put_var_td_real
1745
1746	subroutine ext_pnc_put_var_ti_double(DataHandle,Element,Var,Data,Count,Status)
1747	#undef ROUTINE_TYPE
1748	#undef TYPE_DATA
1749	#undef TYPE_COUNT
1750	#undef NF_ROUTINE
1751	#undef ARGS
1752	#undef LOG
1753	#define ROUTINE_TYPE 'DOUBLE'
1754	#define TYPE_DATA real8 ,intent(in) :: Data()
1755	#define TYPE_COUNT integer ,intent(in) :: Count
1756	#define NF_ROUTINE NFMPI_PUT_ATT_DOUBLE
1757	#define ARGS NF_DOUBLE,i2offset(Count),Data
1758	#include "ext_pnc_put_var_ti.code"
1759	end subroutine ext_pnc_put_var_ti_double
1760
1761	subroutine ext_pnc_put_var_td_double(DataHandle,Element,DateStr,Var,Data,Count,Status)
1762	#undef ROUTINE_TYPE
1763	#undef TYPE_DATA
1764	#undef TYPE_COUNT
1765	#undef NF_ROUTINE
1766	#undef NF_TYPE
1767	#undef LENGTH
1768	#undef ARG
1769	#undef LOG
1770	#define ROUTINE_TYPE 'DOUBLE'
1771	#define TYPE_DATA real8,intent(in) :: Data()
1772	#define TYPE_COUNT integer ,intent(in) :: Count
1773	#define NF_ROUTINE NFMPI_PUT_VARA_DOUBLE_ALL
1774	#define NF_TYPE NF_DOUBLE
1775	#define LENGTH Count
1776	#define ARG
1777	#include "ext_pnc_put_var_td.code"
1778	end subroutine ext_pnc_put_var_td_double
1779
1780	subroutine ext_pnc_put_var_ti_integer(DataHandle,Element,Var,Data,Count,Status)
1781	#undef ROUTINE_TYPE
1782	#undef TYPE_DATA
1783	#undef TYPE_COUNT
1784	#undef NF_ROUTINE
1785	#undef ARGS
1786	#undef LOG
1787	#define ROUTINE_TYPE 'INTEGER'
1788	#define TYPE_DATA integer ,intent(in) :: Data(*)
1789	#define TYPE_COUNT integer ,intent(in) :: Count
1790	#define NF_ROUTINE NFMPI_PUT_ATT_INT
1791	#define ARGS NF_INT,i2offset(Count),Data
1792	#include "ext_pnc_put_var_ti.code"
1793	end subroutine ext_pnc_put_var_ti_integer
1794
1795	subroutine ext_pnc_put_var_td_integer(DataHandle,Element,DateStr,Var,Data,Count,Status)
1796	#undef ROUTINE_TYPE
1797	#undef TYPE_DATA
1798	#undef TYPE_COUNT
1799	#undef NF_ROUTINE
1800	#undef NF_TYPE
1801	#undef LENGTH
1802	#undef ARG
1803	#undef LOG
1804	#define ROUTINE_TYPE 'INTEGER'
1805	#define TYPE_DATA integer ,intent(in) :: Data(*)
1806	#define TYPE_COUNT integer ,intent(in) :: Count
1807	#define NF_ROUTINE NFMPI_PUT_VARA_INT_ALL
1808	#define NF_TYPE NF_INT
1809	#define LENGTH Count
1810	#define ARG
1811	#include "ext_pnc_put_var_td.code"
1812	end subroutine ext_pnc_put_var_td_integer
1813
1814	subroutine ext_pnc_put_var_ti_logical(DataHandle,Element,Var,Data,Count,Status)
1815	#undef ROUTINE_TYPE
1816	#undef TYPE_DATA
1817	#undef TYPE_COUNT
1818	#undef NF_ROUTINE
1819	#undef ARGS
1820	#define ROUTINE_TYPE 'LOGICAL'
1821	#define TYPE_DATA logical ,intent(in) :: Data(*)
1822	#define TYPE_COUNT integer ,intent(in) :: Count
1823	#define NF_ROUTINE NFMPI_PUT_ATT_INT
1824	#define LOG
1825	#define ARGS NF_INT,i2offset(Count),Buffer
1826	#include "ext_pnc_put_var_ti.code"
1827	end subroutine ext_pnc_put_var_ti_logical
1828
1829	subroutine ext_pnc_put_var_td_logical(DataHandle,Element,DateStr,Var,Data,Count,Status)
1830	#undef ROUTINE_TYPE
1831	#undef TYPE_DATA
1832	#undef TYPE_COUNT
1833	#undef NF_ROUTINE
1834	#undef NF_TYPE
1835	#undef LENGTH
1836	#undef ARG
1837	#define ROUTINE_TYPE 'LOGICAL'
1838	#define TYPE_DATA logical ,intent(in) :: Data(*)
1839	#define TYPE_COUNT integer ,intent(in) :: Count
1840	#define NF_ROUTINE NFMPI_PUT_VARA_INT_ALL
1841	#define NF_TYPE NF_INT
1842	#define LOG
1843	#define LENGTH Count
1844	#define ARG
1845	#include "ext_pnc_put_var_td.code"
1846	end subroutine ext_pnc_put_var_td_logical
1847
1848	subroutine ext_pnc_put_var_ti_char(DataHandle,Element,Var,Data,Status)
1849	#undef ROUTINE_TYPE
1850	#undef TYPE_DATA
1851	#undef TYPE_COUNT
1852	#undef NF_ROUTINE
1853	#undef ARGS
1854	#undef LOG
1855	#define ROUTINE_TYPE 'CHAR'
1856	#define TYPE_DATA character() ,intent(in) :: Data
1857	#define TYPE_COUNT
1858	#define NF_ROUTINE NFMPI_PUT_ATT_TEXT
1859	#define ARGS i2offset(len_trim(Data)),trim(Data)
1860	#define CHAR_TYPE
1861	#include "ext_pnc_put_var_ti.code"
1862	#undef CHAR_TYPE
1863	end subroutine ext_pnc_put_var_ti_char
1864
1865	subroutine ext_pnc_put_var_td_char(DataHandle,Element,DateStr,Var,Data,Status)
1866	#undef ROUTINE_TYPE
1867	#undef TYPE_DATA
1868	#undef TYPE_COUNT
1869	#undef NF_ROUTINE
1870	#undef NF_TYPE
1871	#undef LENGTH
1872	#undef ARG
1873	#undef LOG
1874	#define ROUTINE_TYPE 'CHAR'
1875	#define TYPE_DATA character() ,intent(in) :: Data
1876	#define TYPE_COUNT
1877	#define NF_ROUTINE NFMPI_PUT_VARA_TEXT_ALL
1878	#define NF_TYPE NF_CHAR
1879	#define LENGTH len(Data)
1880	#include "ext_pnc_put_var_td.code"
1881	end subroutine ext_pnc_put_var_td_char
1882
1883	subroutine ext_pnc_get_var_ti_real(DataHandle,Element,Var,Data,Count,OutCount,Status)
1884	#undef ROUTINE_TYPE
1885	#undef TYPE_DATA
1886	#undef TYPE_BUFFER
1887	#undef TYPE_COUNT
1888	#undef TYPE_OUTCOUNT
1889	#undef NF_TYPE
1890	#undef NF_ROUTINE
1891	#undef COPY
1892	#define ROUTINE_TYPE 'REAL'
1893	#define TYPE_DATA real ,intent(out) :: Data(*)
1894	#define TYPE_BUFFER real ,allocatable :: Buffer(:)
1895	#define TYPE_COUNT integer,intent(in) :: Count
1896	#define TYPE_OUTCOUNT integer,intent(out) :: OutCount
1897	#define NF_TYPE NF_FLOAT
1898	#define NF_ROUTINE NFMPI_GET_ATT_REAL
1899	#define COPY Data(1:min(XLen,Count)) = Buffer(1:min(XLen,Count))
1900	#include "ext_pnc_get_var_ti.code"
1901	end subroutine ext_pnc_get_var_ti_real
1902
1903	subroutine ext_pnc_get_var_td_real(DataHandle,Element,DateStr,Var,Data,Count,OutCount,Status)
1904	#undef ROUTINE_TYPE
1905	#undef TYPE_DATA
1906	#undef TYPE_BUFFER
1907	#undef TYPE_COUNT
1908	#undef TYPE_OUTCOUNT
1909	#undef NF_TYPE
1910	#undef NF_ROUTINE
1911	#undef LENGTH
1912	#undef COPY
1913	#define ROUTINE_TYPE 'REAL'
1914	#define TYPE_DATA real ,intent(out) :: Data(*)
1915	#define TYPE_BUFFER real
1916	#define TYPE_COUNT integer,intent(in) :: Count
1917	#define TYPE_OUTCOUNT integer,intent(out) :: OutCount
1918	#define NF_TYPE NF_FLOAT
1919	#define NF_ROUTINE NFMPI_GET_VARA_REAL_ALL
1920	#define LENGTH min(Count,Len1)
1921	#define COPY Data(1:min(Len1,Count)) = Buffer(1:min(Len1,Count))
1922	#include "ext_pnc_get_var_td.code"
1923	end subroutine ext_pnc_get_var_td_real
1924
1925	subroutine ext_pnc_get_var_ti_double(DataHandle,Element,Var,Data,Count,OutCount,Status)
1926	#undef ROUTINE_TYPE
1927	#undef TYPE_DATA
1928	#undef TYPE_BUFFER
1929	#undef TYPE_COUNT
1930	#undef TYPE_OUTCOUNT
1931	#undef NF_TYPE
1932	#undef NF_ROUTINE
1933	#undef COPY
1934	#define ROUTINE_TYPE 'DOUBLE'
1935	#define TYPE_DATA real8 ,intent(out) :: Data()
1936	#define TYPE_BUFFER real*8 ,allocatable :: Buffer(:)
1937	#define TYPE_COUNT integer,intent(in) :: Count
1938	#define TYPE_OUTCOUNT integer,intent(out) :: OutCount
1939	#define NF_TYPE NF_DOUBLE
1940	#define NF_ROUTINE NFMPI_GET_ATT_DOUBLE
1941	#define COPY Data(1:min(XLen,Count)) = Buffer(1:min(XLen,Count))
1942	#include "ext_pnc_get_var_ti.code"
1943	end subroutine ext_pnc_get_var_ti_double
1944
1945	subroutine ext_pnc_get_var_td_double(DataHandle,Element,DateStr,Var,Data,Count,OutCount,Status)
1946	#undef ROUTINE_TYPE
1947	#undef TYPE_DATA
1948	#undef TYPE_BUFFER
1949	#undef TYPE_COUNT
1950	#undef TYPE_OUTCOUNT
1951	#undef NF_TYPE
1952	#undef NF_ROUTINE
1953	#undef LENGTH
1954	#undef COPY
1955	#define ROUTINE_TYPE 'DOUBLE'
1956	#define TYPE_DATA real8 ,intent(out) :: Data()
1957	#define TYPE_BUFFER real*8
1958	#define TYPE_COUNT integer,intent(in) :: Count
1959	#define TYPE_OUTCOUNT integer,intent(out) :: OutCount
1960	#define NF_TYPE NF_DOUBLE
1961	#define NF_ROUTINE NFMPI_GET_VARA_DOUBLE_ALL
1962	#define LENGTH min(Count,Len1)
1963	#define COPY Data(1:min(Len1,Count)) = Buffer(1:min(Len1,Count))
1964	#include "ext_pnc_get_var_td.code"
1965	end subroutine ext_pnc_get_var_td_double
1966
1967	subroutine ext_pnc_get_var_ti_integer(DataHandle,Element,Var,Data,Count,OutCount,Status)
1968	#undef ROUTINE_TYPE
1969	#undef TYPE_DATA
1970	#undef TYPE_BUFFER
1971	#undef TYPE_COUNT
1972	#undef TYPE_OUTCOUNT
1973	#undef NF_TYPE
1974	#undef NF_ROUTINE
1975	#undef COPY
1976	#define ROUTINE_TYPE 'INTEGER'
1977	#define TYPE_DATA integer,intent(out) :: Data(*)
1978	#define TYPE_BUFFER integer,allocatable :: Buffer(:)
1979	#define TYPE_COUNT integer,intent(in) :: Count
1980	#define TYPE_OUTCOUNT integer,intent(out) :: OutCount
1981	#define NF_TYPE NF_INT
1982	#define NF_ROUTINE NFMPI_GET_ATT_INT
1983	#define COPY Data(1:min(XLen,Count)) = Buffer(1:min(XLen,Count))
1984	#include "ext_pnc_get_var_ti.code"
1985	end subroutine ext_pnc_get_var_ti_integer
1986
1987	subroutine ext_pnc_get_var_td_integer(DataHandle,Element,DateStr,Var,Data,Count,OutCount,Status)
1988	#undef ROUTINE_TYPE
1989	#undef TYPE_DATA
1990	#undef TYPE_BUFFER
1991	#undef TYPE_COUNT
1992	#undef TYPE_OUTCOUNT
1993	#undef NF_TYPE
1994	#undef NF_ROUTINE
1995	#undef LENGTH
1996	#undef COPY
1997	#define ROUTINE_TYPE 'INTEGER'
1998	#define TYPE_DATA integer,intent(out) :: Data(*)
1999	#define TYPE_BUFFER integer
2000	#define TYPE_COUNT integer,intent(in) :: Count
2001	#define TYPE_OUTCOUNT integer,intent(out) :: OutCount
2002	#define NF_TYPE NF_INT
2003	#define NF_ROUTINE NFMPI_GET_VARA_INT_ALL
2004	#define LENGTH min(Count,Len1)
2005	#define COPY Data(1:min(Len1,Count)) = Buffer(1:min(Len1,Count))
2006	#include "ext_pnc_get_var_td.code"
2007	end subroutine ext_pnc_get_var_td_integer
2008
2009	subroutine ext_pnc_get_var_ti_logical(DataHandle,Element,Var,Data,Count,OutCount,Status)
2010	#undef ROUTINE_TYPE
2011	#undef TYPE_DATA
2012	#undef TYPE_BUFFER
2013	#undef TYPE_COUNT
2014	#undef TYPE_OUTCOUNT
2015	#undef NF_TYPE
2016	#undef NF_ROUTINE
2017	#undef COPY
2018	#define ROUTINE_TYPE 'LOGICAL'
2019	#define TYPE_DATA logical,intent(out) :: Data(*)
2020	#define TYPE_BUFFER integer,allocatable :: Buffer(:)
2021	#define TYPE_COUNT integer,intent(in) :: Count
2022	#define TYPE_OUTCOUNT integer,intent(out) :: OutCount
2023	#define NF_TYPE NF_INT
2024	#define NF_ROUTINE NFMPI_GET_ATT_INT
2025	#define COPY Data(1:min(XLen,Count)) = Buffer(1:min(XLen,Count))==1
2026	#include "ext_pnc_get_var_ti.code"
2027	end subroutine ext_pnc_get_var_ti_logical
2028
2029	subroutine ext_pnc_get_var_td_logical(DataHandle,Element,DateStr,Var,Data,Count,OutCount,Status)
2030	#undef ROUTINE_TYPE
2031	#undef TYPE_DATA
2032	#undef TYPE_BUFFER
2033	#undef TYPE_COUNT
2034	#undef TYPE_OUTCOUNT
2035	#undef NF_TYPE
2036	#undef NF_ROUTINE
2037	#undef LENGTH
2038	#undef COPY
2039	#define ROUTINE_TYPE 'LOGICAL'
2040	#define TYPE_DATA logical,intent(out) :: Data(*)
2041	#define TYPE_BUFFER integer
2042	#define TYPE_COUNT integer,intent(in) :: Count
2043	#define TYPE_OUTCOUNT integer,intent(out) :: OutCount
2044	#define NF_TYPE NF_INT
2045	#define NF_ROUTINE NFMPI_GET_VARA_INT_ALL
2046	#define LENGTH min(Count,Len1)
2047	#define COPY Data(1:min(Len1,Count)) = Buffer(1:min(Len1,Count))==1
2048	#include "ext_pnc_get_var_td.code"
2049	end subroutine ext_pnc_get_var_td_logical
2050
2051	subroutine ext_pnc_get_var_ti_char(DataHandle,Element,Var,Data,Status)
2052	#undef ROUTINE_TYPE
2053	#undef TYPE_DATA
2054	#undef TYPE_BUFFER
2055	#undef TYPE_COUNT
2056	#undef TYPE_OUTCOUNT
2057	#undef NF_TYPE
2058	#undef NF_ROUTINE
2059	#undef COPY
2060	#define ROUTINE_TYPE 'CHAR'
2061	#define TYPE_DATA character() ,intent(out) :: Data
2062	#define TYPE_BUFFER
2063	#define TYPE_COUNT integer :: Count = 1
2064	#define TYPE_OUTCOUNT
2065	#define NF_TYPE NF_CHAR
2066	#define NF_ROUTINE NFMPI_GET_ATT_TEXT
2067	#define COPY
2068	#define CHAR_TYPE
2069	#include "ext_pnc_get_var_ti.code"
2070	#undef CHAR_TYPE
2071	end subroutine ext_pnc_get_var_ti_char
2072
2073	subroutine ext_pnc_get_var_td_char(DataHandle,Element,DateStr,Var,Data,Status)
2074	#undef ROUTINE_TYPE
2075	#undef TYPE_DATA
2076	#undef TYPE_BUFFER
2077	#undef TYPE_COUNT
2078	#undef TYPE_OUTCOUNT
2079	#undef NF_TYPE
2080	#undef NF_ROUTINE
2081	#undef LENGTH
2082	#define ROUTINE_TYPE 'CHAR'
2083	#define TYPE_DATA character() ,intent(out) :: Data
2084	#define TYPE_BUFFER character (80)
2085	#define TYPE_COUNT integer :: Count = 1
2086	#define TYPE_OUTCOUNT
2087	#define NF_TYPE NF_CHAR
2088	#define NF_ROUTINE NFMPI_GET_VARA_TEXT_ALL
2089	#define LENGTH Len1
2090	#define CHAR_TYPE
2091	#include "ext_pnc_get_var_td.code"
2092	#undef CHAR_TYPE
2093	end subroutine ext_pnc_get_var_td_char
2094
2095	subroutine ext_pnc_put_dom_td_real(DataHandle,Element,DateStr,Data,Count,Status)
2096	integer ,intent(in) :: DataHandle
2097	character() ,intent(in) :: Element
2098	character() ,intent(in) :: DateStr
2099	real ,intent(in) :: Data(*)
2100	integer ,intent(in) :: Count
2101	integer ,intent(out) :: Status
2102
2103	call ext_pnc_put_var_td_real(DataHandle,Element,DateStr, &
2104	'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Count,Status)
2105	return
2106	end subroutine ext_pnc_put_dom_td_real
2107
2108	subroutine ext_pnc_put_dom_td_integer(DataHandle,Element,DateStr,Data,Count,Status)
2109	integer ,intent(in) :: DataHandle
2110	character() ,intent(in) :: Element
2111	character() ,intent(in) :: DateStr
2112	integer ,intent(in) :: Data(*)
2113	integer ,intent(in) :: Count
2114	integer ,intent(out) :: Status
2115
2116	call ext_pnc_put_var_td_integer(DataHandle,Element,DateStr, &
2117	'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Count,Status)
2118	return
2119	end subroutine ext_pnc_put_dom_td_integer
2120
2121	subroutine ext_pnc_put_dom_td_double(DataHandle,Element,DateStr,Data,Count,Status)
2122	integer ,intent(in) :: DataHandle
2123	character() ,intent(in) :: Element
2124	character() ,intent(in) :: DateStr
2125	real8 ,intent(in) :: Data()
2126	integer ,intent(in) :: Count
2127	integer ,intent(out) :: Status
2128
2129	call ext_pnc_put_var_td_double(DataHandle,Element,DateStr, &
2130	'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Count,Status)
2131	return
2132	end subroutine ext_pnc_put_dom_td_double
2133
2134	subroutine ext_pnc_put_dom_td_logical(DataHandle,Element,DateStr,Data,Count,Status)
2135	integer ,intent(in) :: DataHandle
2136	character() ,intent(in) :: Element
2137	character() ,intent(in) :: DateStr
2138	logical ,intent(in) :: Data(*)
2139	integer ,intent(in) :: Count
2140	integer ,intent(out) :: Status
2141
2142	call ext_pnc_put_var_td_logical(DataHandle,Element,DateStr, &
2143	'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Count,Status)
2144	return
2145	end subroutine ext_pnc_put_dom_td_logical
2146
2147	subroutine ext_pnc_put_dom_td_char(DataHandle,Element,DateStr,Data,Status)
2148	integer ,intent(in) :: DataHandle
2149	character() ,intent(in) :: Element
2150	character() ,intent(in) :: DateStr
2151	character() ,intent(in) :: Data
2152	integer ,intent(out) :: Status
2153
2154	call ext_pnc_put_var_td_char(DataHandle,Element,DateStr, &
2155	'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Status)
2156	return
2157	end subroutine ext_pnc_put_dom_td_char
2158
2159	subroutine ext_pnc_get_dom_td_real(DataHandle,Element,DateStr,Data,Count,OutCount,Status)
2160	integer ,intent(in) :: DataHandle
2161	character() ,intent(in) :: Element
2162	character() ,intent(in) :: DateStr
2163	real ,intent(out) :: Data(*)
2164	integer ,intent(in) :: Count
2165	integer ,intent(out) :: OutCount
2166	integer ,intent(out) :: Status
2167	call ext_pnc_get_var_td_real(DataHandle,Element,DateStr, &
2168	'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Count,OutCount,Status)
2169	return
2170	end subroutine ext_pnc_get_dom_td_real
2171
2172	subroutine ext_pnc_get_dom_td_integer(DataHandle,Element,DateStr,Data,Count,OutCount,Status)
2173	integer ,intent(in) :: DataHandle
2174	character() ,intent(in) :: Element
2175	character() ,intent(in) :: DateStr
2176	integer ,intent(out) :: Data(*)
2177	integer ,intent(in) :: Count
2178	integer ,intent(out) :: OutCount
2179	integer ,intent(out) :: Status
2180	call ext_pnc_get_var_td_integer(DataHandle,Element,DateStr, &
2181	'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Count,OutCount,Status)
2182	return
2183	end subroutine ext_pnc_get_dom_td_integer
2184
2185	subroutine ext_pnc_get_dom_td_double(DataHandle,Element,DateStr,Data,Count,OutCount,Status)
2186	integer ,intent(in) :: DataHandle
2187	character() ,intent(in) :: Element
2188	character() ,intent(in) :: DateStr
2189	real8 ,intent(out) :: Data()
2190	integer ,intent(in) :: Count
2191	integer ,intent(out) :: OutCount
2192	integer ,intent(out) :: Status
2193	call ext_pnc_get_var_td_double(DataHandle,Element,DateStr, &
2194	'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Count,OutCount,Status)
2195	return
2196	end subroutine ext_pnc_get_dom_td_double
2197
2198	subroutine ext_pnc_get_dom_td_logical(DataHandle,Element,DateStr,Data,Count,OutCount,Status)
2199	integer ,intent(in) :: DataHandle
2200	character() ,intent(in) :: Element
2201	character() ,intent(in) :: DateStr
2202	logical ,intent(out) :: Data(*)
2203	integer ,intent(in) :: Count
2204	integer ,intent(out) :: OutCount
2205	integer ,intent(out) :: Status
2206	call ext_pnc_get_var_td_logical(DataHandle,Element,DateStr, &
2207	'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Count,OutCount,Status)
2208	return
2209	end subroutine ext_pnc_get_dom_td_logical
2210
2211	subroutine ext_pnc_get_dom_td_char(DataHandle,Element,DateStr,Data,Status)
2212	integer ,intent(in) :: DataHandle
2213	character() ,intent(in) :: Element
2214	character() ,intent(in) :: DateStr
2215	character() ,intent(out) :: Data
2216	integer ,intent(out) :: Status
2217	call ext_pnc_get_var_td_char(DataHandle,Element,DateStr, &
2218	'E_X_T_D_O_M_A_I_N_M_E_T_A_DATA_' ,Data,Status)
2219	return
2220	end subroutine ext_pnc_get_dom_td_char
2221
2222
2223	subroutine ext_pnc_write_field(DataHandle,DateStr,Var,Field,FieldType,Comm, &
2224	IOComm, DomainDesc, MemoryOrdIn, Stagger, DimNames, &
2225	DomainStart,DomainEnd,MemoryStart,MemoryEnd,PatchStart,PatchEnd,Status)
2226	use wrf_data_pnc
2227	use ext_pnc_support_routines
2228	implicit none
2229	include 'wrf_status_codes.h'
2230	# include "pnetcdf.inc"
2231	integer ,intent(in) :: DataHandle
2232	character() ,intent(in) :: DateStr
2233	character() ,intent(in) :: Var
2234	integer ,intent(inout) :: Field(*)
2235	integer ,intent(in) :: FieldType
2236	integer ,intent(inout) :: Comm
2237	integer ,intent(inout) :: IOComm
2238	integer ,intent(in) :: DomainDesc
2239	character() ,intent(in) :: MemoryOrdIn
2240	character() ,intent(in) :: Stagger ! Dummy for now
2241	character() ,dimension(*) ,intent(in) :: DimNames
2242	integer ,dimension(*) ,intent(in) :: DomainStart, DomainEnd
2243	integer ,dimension(*) ,intent(in) :: MemoryStart, MemoryEnd
2244	integer ,dimension(*) ,intent(in) :: PatchStart, PatchEnd
2245	integer ,intent(out) :: Status
2246	character (3) :: MemoryOrder
2247	type(wrf_data_handle) ,pointer :: DH
2248	integer :: NCID
2249	integer :: NDim
2250	character (VarNameLen) :: VarName
2251	character (3) :: MemO
2252	character (3) :: UCMemO
2253	integer :: VarID
2254	integer ,dimension(NVarDims) :: Length_global
2255	integer ,dimension(NVarDims) :: Length
2256	integer ,dimension(NVarDims) :: VDimIDs
2257	character(80),dimension(NVarDims) :: RODimNames
2258	integer ,dimension(NVarDims) :: StoredStart
2259	integer ,dimension(:,:,:,:),allocatable :: XField
2260	integer :: stat
2261	integer :: NVar
2262	integer :: i,j
2263	integer :: i1,i2,j1,j2,k1,k2
2264	integer :: x1,x2,y1,y2,z1,z2
2265	integer :: l1,l2,m1,m2,n1,n2
2266	integer :: XType
2267	integer :: di
2268	character (80) :: NullName
2269	logical :: NotFound
2270
2271	MemoryOrder = trim(adjustl(MemoryOrdIn))
2272	NullName=char(0)
2273	call GetDim(MemoryOrder,NDim,Status)
2274	if(Status /= WRF_NO_ERR) then
2275	write(msg,*) 'Warning BAD MEMORY ORDER \|',MemoryOrder,'\| in ',__FILE__,', line', __LINE__
2276	call wrf_debug ( WARN , TRIM(msg))
2277	return
2278	endif
2279	call DateCheck(DateStr,Status)
2280	if(Status /= WRF_NO_ERR) then
2281	write(msg,*) 'Warning DATE STRING ERROR \|',DateStr,'\| in ',__FILE__,', line', __LINE__
2282	call wrf_debug ( WARN , TRIM(msg))
2283	return
2284	endif
2285	VarName = Var
2286	call GetDH(DataHandle,DH,Status)
2287	if(Status /= WRF_NO_ERR) then
2288	write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
2289	call wrf_debug ( WARN , TRIM(msg))
2290	return
2291	endif
2292	NCID = DH%NCID
2293
2294	write(msg,*)'ext_pnc_write_field: called for ',TRIM(Var)
2295	CALL wrf_debug( 100, msg )
2296
2297	!jm 20061024
2298	Length(1:NDim) = PatchEnd(1:NDim)-PatchStart(1:NDim)+1
2299	Length_global(1:NDim) = DomainEnd(1:NDim)-DomainStart(1:NDim)+1
2300
2301
2302	call ExtOrder(MemoryOrder,Length,Status)
2303	call ExtOrder(MemoryOrder,Length_global,Status)
2304
2305	call ExtOrderStr(MemoryOrder,DimNames,RODimNames,Status)
2306
2307	if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
2308	Status = WRF_WARN_FILE_NOT_OPENED
2309	write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
2310	call wrf_debug ( WARN , TRIM(msg))
2311	elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
2312	Status = WRF_WARN_WRITE_RONLY_FILE
2313	write(msg,*) 'Warning WRITE READ ONLY FILE in ',__FILE__,', line', __LINE__
2314	call wrf_debug ( WARN , TRIM(msg))
2315	elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
2316	do NVar=1,MaxVars
2317	if(DH%VarNames(NVar) == VarName ) then
2318	Status = WRF_WARN_2DRYRUNS_1VARIABLE
2319	write(msg,*) 'Warning 2 DRYRUNS 1 VARIABLE in ',__FILE__,', line', __LINE__
2320	call wrf_debug ( WARN , TRIM(msg))
2321	return
2322	elseif(DH%VarNames(NVar) == NO_NAME) then
2323	DH%VarNames(NVar) = VarName
2324	DH%NumVars = NVar
2325	exit
2326	elseif(NVar == MaxVars) then
2327	Status = WRF_WARN_TOO_MANY_VARIABLES
2328	write(msg,*) 'Warning TOO MANY VARIABLES in ',__FILE__,', line', __LINE__
2329	call wrf_debug ( WARN , TRIM(msg))
2330	return
2331	endif
2332	enddo
2333	do j = 1,NDim
2334	if(RODimNames(j) == NullName .or. RODimNames(j) == '') then
2335	do i=1,MaxDims
2336	if(DH%DimLengths(i) == Length_global(j)) then
2337	exit
2338	elseif(DH%DimLengths(i) == NO_DIM) then
2339	stat = NFMPI_DEF_DIM(NCID,DH%DimNames(i),i2offset(Length_global(j)),DH%DimIDs(i))
2340	call netcdf_err(stat,Status)
2341	if(Status /= WRF_NO_ERR) then
2342	write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
2343	call wrf_debug ( WARN , TRIM(msg))
2344	return
2345	endif
2346	DH%DimLengths(i) = Length_global(j)
2347	exit
2348	elseif(i == MaxDims) then
2349	Status = WRF_WARN_TOO_MANY_DIMS
2350	write(msg,*) 'Warning TOO MANY DIMENSIONS in ',__FILE__,', line', __LINE__
2351	call wrf_debug ( WARN , TRIM(msg))
2352	return
2353	endif
2354	enddo
2355	else !look for input name and check if already defined
2356	NotFound = .true.
2357	do i=1,MaxDims
2358	if (DH%DimNames(i) == RODimNames(j)) then
2359	if (DH%DimLengths(i) == Length_global(j)) then
2360	NotFound = .false.
2361	exit
2362	else
2363	Status = WRF_WARN_DIMNAME_REDEFINED
2364	write(msg,*) 'Warning DIM ',i,', NAME ',TRIM(DH%DimNames(i)),' REDIFINED by var ', &
2365	TRIM(Var),' ',DH%DimLengths(i),Length_global(j) ,' in ', __FILE__ ,' line', __LINE__
2366	call wrf_debug ( WARN , TRIM(msg))
2367	return
2368	endif
2369	endif
2370	enddo
2371	if (NotFound) then
2372	do i=1,MaxDims
2373	if (DH%DimLengths(i) == NO_DIM) then
2374	DH%DimNames(i) = RODimNames(j)
2375	stat = NFMPI_DEF_DIM(NCID,DH%DimNames(i),i2offset(Length_global(j)),DH%DimIDs(i))
2376	call netcdf_err(stat,Status)
2377	if(Status /= WRF_NO_ERR) then
2378	write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
2379	call wrf_debug ( WARN , TRIM(msg))
2380	return
2381	endif
2382	DH%DimLengths(i) = Length_global(j)
2383	exit
2384	elseif(i == MaxDims) then
2385	Status = WRF_WARN_TOO_MANY_DIMS
2386	write(msg,*) 'Warning TOO MANY DIMENSIONS in ',__FILE__,', line', __LINE__
2387	call wrf_debug ( WARN , TRIM(msg))
2388	return
2389	endif
2390	enddo
2391	endif
2392	endif
2393	VDimIDs(j) = DH%DimIDs(i)
2394	DH%VarDimLens(j,NVar) = Length_global(j)
2395	enddo
2396	VDimIDs(NDim+1) = DH%DimUnlimID
2397	select case (FieldType)
2398	case (WRF_REAL)
2399	XType = NF_FLOAT
2400	case (WRF_DOUBLE)
2401	Xtype = NF_DOUBLE
2402	case (WRF_INTEGER)
2403	XType = NF_INT
2404	case (WRF_LOGICAL)
2405	XType = NF_INT
2406	case default
2407	Status = WRF_WARN_DATA_TYPE_NOT_FOUND
2408	write(msg,*) 'Warning DATA TYPE NOT FOUND in ',__FILE__,', line', __LINE__
2409	call wrf_debug ( WARN , TRIM(msg))
2410	return
2411	end select
2412
2413
2414	stat = NFMPI_DEF_VAR(NCID,VarName,XType,NDim+1,VDimIDs,VarID)
2415	call netcdf_err(stat,Status)
2416	if(Status /= WRF_NO_ERR) then
2417	write(msg,*) 'ext_pnc_write_field: NetCDF error for ',TRIM(VarName),' in ',__FILE__,', line', __LINE__
2418	call wrf_debug ( WARN , TRIM(msg))
2419	return
2420	endif
2421	DH%VarIDs(NVar) = VarID
2422	stat = NFMPI_PUT_ATT_INT(NCID,VarID,'FieldType',NF_INT,i2offset(1),FieldType)
2423	call netcdf_err(stat,Status)
2424	if(Status /= WRF_NO_ERR) then
2425	write(msg,*) 'ext_pnc_write_field: NetCDF error in ',__FILE__,', line', __LINE__
2426	call wrf_debug ( WARN , TRIM(msg))
2427	return
2428	endif
2429	call reorder(MemoryOrder,MemO)
2430	call uppercase(MemO,UCMemO)
2431	stat = NFMPI_PUT_ATT_TEXT(NCID,VarID,'MemoryOrder',i2offset(3),UCMemO)
2432	call netcdf_err(stat,Status)
2433	if(Status /= WRF_NO_ERR) then
2434	write(msg,*) 'ext_pnc_write_field: NetCDF error in ',__FILE__,', line', __LINE__
2435	call wrf_debug ( WARN , TRIM(msg))
2436	return
2437	endif
2438	elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE .OR. DH%FileStatus == WRF_FILE_OPENED_FOR_UPDATE) then
2439	do NVar=1,DH%NumVars
2440	if(DH%VarNames(NVar) == VarName) then
2441	exit
2442	elseif(NVar == DH%NumVars) then
2443	Status = WRF_WARN_VAR_NF
2444	write(msg,*) 'Warning VARIABLE NOT FOUND in ',__FILE__,', line', __LINE__
2445	call wrf_debug ( WARN , TRIM(msg))
2446	return
2447	endif
2448	enddo
2449	VarID = DH%VarIDs(NVar)
2450	do j=1,NDim
2451	if(Length_global(j) /= DH%VarDimLens(j,NVar) .AND. DH%FileStatus /= WRF_FILE_OPENED_FOR_UPDATE ) then
2452	Status = WRF_WARN_WRTLEN_NE_DRRUNLEN
2453	write(msg,*) 'Warning LENGTH != DRY RUN LENGTH for \|', &
2454	VarName,'\| dim ',j,' in ',__FILE__,', line', __LINE__
2455	call wrf_debug ( WARN , TRIM(msg))
2456	write(msg,*) ' LENGTH ',Length_global(j),' DRY RUN LENGTH ',DH%VarDimLens(j,NVar)
2457	call wrf_debug ( WARN , TRIM(msg))
2458	return
2459	!jm 061024 elseif(PatchStart(j) < MemoryStart(j)) then
2460	!jm elseif(DomainStart(j) < MemoryStart(j)) then
2461	elseif(PatchStart(j) < MemoryStart(j)) then
2462	Status = WRF_WARN_DIMENSION_ERROR
2463	write(msg,*) 'Warning DIMENSION ERROR for \|',VarName, &
2464	'\| in ',__FILE__,', line', __LINE__
2465	call wrf_debug ( WARN , TRIM(msg))
2466	return
2467	endif
2468	enddo
2469	StoredStart = 1
2470	call GetIndices(NDim,MemoryStart,MemoryEnd,l1,l2,m1,m2,n1,n2)
2471	call GetIndices(NDim,StoredStart,Length ,x1,x2,y1,y2,z1,z2)
2472	call GetIndices(NDim,PatchStart, PatchEnd ,i1,i2,j1,j2,k1,k2)
2473	di=1
2474	if(FieldType == WRF_DOUBLE) di=2
2475	allocate(XField(di,x1:x2,y1:y2,z1:z2), STAT=stat)
2476	if(stat/= 0) then
2477	Status = WRF_ERR_FATAL_ALLOCATION_ERROR
2478	write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
2479	call wrf_debug ( FATAL , TRIM(msg))
2480	return
2481	endif
2482	call Transpose('write',MemoryOrder,di, Field,l1,l2,m1,m2,n1,n2 &
2483	,XField,x1,x2,y1,y2,z1,z2 &
2484	,i1,i2,j1,j2,k1,k2 )
2485	StoredStart(1:NDim) = PatchStart(1:NDim)
2486	call ExtOrder(MemoryOrder,StoredStart,Status)
2487	call FieldIO('write',DataHandle,DateStr,StoredStart,Length,MemoryOrder, &
2488	FieldType,NCID,VarID,XField,Status)
2489	if(Status /= WRF_NO_ERR) then
2490	write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
2491	call wrf_debug ( WARN , TRIM(msg))
2492	return
2493	endif
2494	deallocate(XField, STAT=stat)
2495	if(stat/= 0) then
2496	Status = WRF_ERR_FATAL_DEALLOCATION_ERR
2497	write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
2498	call wrf_debug ( FATAL , TRIM(msg))
2499	return
2500	endif
2501	else
2502	Status = WRF_ERR_FATAL_BAD_FILE_STATUS
2503	write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
2504	call wrf_debug ( FATAL , TRIM(msg))
2505	endif
2506	DH%first_operation = .FALSE.
2507	return
2508	end subroutine ext_pnc_write_field
2509
2510	subroutine ext_pnc_read_field(DataHandle,DateStr,Var,Field,FieldType,Comm, &
2511	IOComm, DomainDesc, MemoryOrdIn, Stagger, DimNames, &
2512	DomainStart,DomainEnd,MemoryStart,MemoryEnd,PatchStart,PatchEnd,Status)
2513	use wrf_data_pnc
2514	use ext_pnc_support_routines
2515	implicit none
2516	include 'wrf_status_codes.h'
2517	# include "pnetcdf.inc"
2518	integer ,intent(in) :: DataHandle
2519	character() ,intent(in) :: DateStr
2520	character() ,intent(in) :: Var
2521	integer ,intent(out) :: Field(*)
2522	integer ,intent(in) :: FieldType
2523	integer ,intent(inout) :: Comm
2524	integer ,intent(inout) :: IOComm
2525	integer ,intent(in) :: DomainDesc
2526	character() ,intent(in) :: MemoryOrdIn
2527	character() ,intent(in) :: Stagger ! Dummy for now
2528	character() , dimension (*) ,intent(in) :: DimNames
2529	integer ,dimension(*) ,intent(in) :: DomainStart, DomainEnd
2530	integer ,dimension(*) ,intent(in) :: MemoryStart, MemoryEnd
2531	integer ,dimension(*) ,intent(in) :: PatchStart, PatchEnd
2532	integer ,intent(out) :: Status
2533	character (3) :: MemoryOrder
2534	character (NF_MAX_NAME) :: dimname
2535	type(wrf_data_handle) ,pointer :: DH
2536	integer :: NDim
2537	integer :: NCID
2538	character (VarNameLen) :: VarName
2539	integer :: VarID
2540	integer ,dimension(NVarDims) :: VCount
2541	integer ,dimension(NVarDims) :: VStart
2542	integer ,dimension(NVarDims) :: Length
2543	integer ,dimension(NVarDims) :: VDimIDs
2544	integer ,dimension(NVarDims) :: MemS
2545	integer ,dimension(NVarDims) :: MemE
2546	integer ,dimension(NVarDims) :: StoredStart
2547	integer ,dimension(NVarDims) :: StoredLen
2548	integer(KIND=MPI_OFFSET_KIND) ,dimension(NVarDims) :: StoredLen_okind
2549	integer ,dimension(:,:,:,:) ,allocatable :: XField
2550	integer :: NVar
2551	integer :: j
2552	integer :: i1,i2,j1,j2,k1,k2
2553	integer :: x1,x2,y1,y2,z1,z2
2554	integer :: l1,l2,m1,m2,n1,n2
2555	character (VarNameLen) :: Name
2556	integer :: XType
2557	integer :: StoredDim
2558	integer :: NAtts
2559	integer(KIND=MPI_OFFSET_KIND) :: Len
2560	integer :: stat
2561	integer :: di
2562	integer :: FType
2563
2564	MemoryOrder = trim(adjustl(MemoryOrdIn))
2565	call GetDim(MemoryOrder,NDim,Status)
2566	if(Status /= WRF_NO_ERR) then
2567	write(msg,*) 'Warning BAD MEMORY ORDER \|',TRIM(MemoryOrder),'\| for \|', &
2568	TRIM(Var),'\| in ext_pnc_read_field ',__FILE__,', line', __LINE__
2569	call wrf_debug ( WARN , TRIM(msg))
2570	return
2571	endif
2572	call DateCheck(DateStr,Status)
2573	if(Status /= WRF_NO_ERR) then
2574	write(msg,*) 'Warning DATE STRING ERROR \|',TRIM(DateStr),'\| for \|',TRIM(Var), &
2575	'\| in ext_pnc_read_field ',__FILE__,', line', __LINE__
2576	call wrf_debug ( WARN , TRIM(msg))
2577	return
2578	endif
2579	VarName = Var
2580	call GetDH(DataHandle,DH,Status)
2581	if(Status /= WRF_NO_ERR) then
2582	write(msg,*) 'Warning Status = ',Status,' in ext_pnc_read_field ',__FILE__,', line', __LINE__
2583	call wrf_debug ( WARN , TRIM(msg))
2584	return
2585	endif
2586	if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
2587	Status = WRF_WARN_FILE_NOT_OPENED
2588	write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
2589	call wrf_debug ( WARN , TRIM(msg))
2590	elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
2591	! jm it is okay to have a dry run read. means read is called between ofrb and ofrc. Just return.
2592	! Status = WRF_WARN_DRYRUN_READ
2593	! write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__
2594	! call wrf_debug ( WARN , TRIM(msg))
2595	Status = WRF_NO_ERR
2596	RETURN
2597	elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
2598	Status = WRF_WARN_READ_WONLY_FILE
2599	write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__
2600	call wrf_debug ( WARN , TRIM(msg))
2601	elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ .OR. DH%FileStatus == WRF_FILE_OPENED_FOR_UPDATE ) then
2602	NCID = DH%NCID
2603
2604	Length(1:NDim) = PatchEnd(1:NDim)-PatchStart(1:NDim)+1
2605	StoredStart(1:NDim) = PatchStart(1:NDim)
2606
2607	call ExtOrder(MemoryOrder,Length,Status)
2608
2609	stat = NFMPI_INQ_VARID(NCID,VarName,VarID)
2610	call netcdf_err(stat,Status)
2611	if(Status /= WRF_NO_ERR) then
2612	write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__,' Varname ',Varname
2613	call wrf_debug ( WARN , TRIM(msg))
2614	return
2615	endif
2616	stat = NFMPI_INQ_VAR(NCID,VarID,Name,XType,StoredDim,VDimIDs,NAtts)
2617	call netcdf_err(stat,Status)
2618	if(Status /= WRF_NO_ERR) then
2619	write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
2620	call wrf_debug ( WARN , TRIM(msg))
2621	return
2622	endif
2623	stat = NFMPI_GET_ATT_INT(NCID,VarID,'FieldType',FType)
2624	call netcdf_err(stat,Status)
2625	if(Status /= WRF_NO_ERR) then
2626	write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
2627	call wrf_debug ( WARN , TRIM(msg))
2628	return
2629	endif
2630	! allow coercion between double and single prec real
2631	!jm if(FieldType /= Ftype) then
2632	if( (FieldType == WRF_REAL .OR. FieldType == WRF_DOUBLE) ) then
2633	if ( .NOT. (Ftype == WRF_REAL .OR. Ftype == WRF_DOUBLE )) then
2634	Status = WRF_WARN_TYPE_MISMATCH
2635	write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
2636	call wrf_debug ( WARN , TRIM(msg))
2637	return
2638	endif
2639	else if(FieldType /= Ftype) then
2640	Status = WRF_WARN_TYPE_MISMATCH
2641	write(msg,*) 'Warning TYPE MISMATCH in ',__FILE__,', line', __LINE__
2642	call wrf_debug ( WARN , TRIM(msg))
2643	return
2644	endif
2645	select case (FieldType)
2646	case (WRF_REAL)
2647	! allow coercion between double and single prec real
2648	if(.NOT. (XType == NF_FLOAT .OR. XType == NF_DOUBLE) ) then
2649	Status = WRF_WARN_TYPE_MISMATCH
2650	write(msg,*) 'Warning REAL TYPE MISMATCH in ',__FILE__,', line', __LINE__
2651	endif
2652	case (WRF_DOUBLE)
2653	! allow coercion between double and single prec real
2654	if(.NOT. (XType == NF_FLOAT .OR. XType == NF_DOUBLE) ) then
2655	Status = WRF_WARN_TYPE_MISMATCH
2656	write(msg,*) 'Warning DOUBLE TYPE MISMATCH in ',__FILE__,', line', __LINE__
2657	endif
2658	case (WRF_INTEGER)
2659	if(XType /= NF_INT) then
2660	Status = WRF_WARN_TYPE_MISMATCH
2661	write(msg,*) 'Warning INTEGER TYPE MISMATCH in ',__FILE__,', line', __LINE__
2662	endif
2663	case (WRF_LOGICAL)
2664	if(XType /= NF_INT) then
2665	Status = WRF_WARN_TYPE_MISMATCH
2666	write(msg,*) 'Warning LOGICAL TYPE MISMATCH in ',__FILE__,', line', __LINE__
2667	endif
2668	case default
2669	Status = WRF_WARN_DATA_TYPE_NOT_FOUND
2670	write(msg,*) 'Warning DATA TYPE NOT FOUND in ',__FILE__,', line', __LINE__
2671	end select
2672	if(Status /= WRF_NO_ERR) then
2673	call wrf_debug ( WARN , TRIM(msg))
2674	return
2675	endif
2676	! NDim=0 for scalars. Handle read of old NDim=1 files. TBH: 20060502
2677	IF ( ( NDim == 0 ) .AND. ( StoredDim == 2 ) ) THEN
2678	stat = NFMPI_INQ_DIMNAME(NCID,VDimIDs(1),dimname)
2679	call netcdf_err(stat,Status)
2680	if(Status /= WRF_NO_ERR) then
2681	write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
2682	call wrf_debug ( WARN , TRIM(msg))
2683	return
2684	endif
2685	IF ( dimname(1:10) == 'ext_scalar' ) THEN
2686	NDim = 1
2687	Length(1) = 1
2688	ENDIF
2689	ENDIF
2690	if(StoredDim /= NDim+1) then
2691	Status = WRF_ERR_FATAL_BAD_VARIABLE_DIM
2692	write(msg,*) 'Fatal error BAD VARIABLE DIMENSION in ext_pnc_read_field ',TRIM(Var),TRIM(DateStr)
2693	call wrf_debug ( FATAL , msg)
2694	write(msg,*) ' StoredDim ', StoredDim, ' .NE. NDim+1 ', NDim+1
2695	call wrf_debug ( FATAL , msg)
2696	return
2697	endif
2698	do j=1,NDim
2699	stat = NFMPI_INQ_DIMLEN(NCID,VDimIDs(j),StoredLen_okind(j))
2700	call netcdf_err(stat,Status)
2701	if(Status /= WRF_NO_ERR) then
2702	write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
2703	call wrf_debug ( WARN , TRIM(msg))
2704	return
2705	endif
2706	StoredLen(j) = StoredLen_okind(j)
2707	if(Length(j) > StoredLen(j)) then
2708	Status = WRF_WARN_READ_PAST_EOF
2709	write(msg,*) 'Warning READ PAST EOF in ext_pnc_read_field of ',TRIM(Var),Length(j),'>',StoredLen(j)
2710	call wrf_debug ( WARN , TRIM(msg))
2711	return
2712	elseif(Length(j) <= 0) then
2713	Status = WRF_WARN_ZERO_LENGTH_READ
2714	write(msg,*) 'Warning ZERO LENGTH READ in ',__FILE__,', line', __LINE__
2715	call wrf_debug ( WARN , TRIM(msg))
2716	return
2717	elseif(DomainStart(j) < MemoryStart(j)) then
2718	Status = WRF_WARN_DIMENSION_ERROR
2719	write(msg,*) 'Warning dim ',j,' DomainStart (',DomainStart(j), &
2720	') < MemoryStart (',MemoryStart(j),') in ',__FILE__,', line', __LINE__
2721	call wrf_debug ( WARN , TRIM(msg))
2722	! return
2723	endif
2724	enddo
2725
2726	StoredStart = 1
2727	call GetIndices(NDim,MemoryStart,MemoryEnd,l1,l2,m1,m2,n1,n2)
2728	call GetIndices(NDim,StoredStart,Length,x1,x2,y1,y2,z1,z2)
2729	!jm call GetIndices(NDim,DomainStart,DomainEnd,i1,i2,j1,j2,k1,k2)
2730	call GetIndices(NDim,PatchStart,PatchEnd,i1,i2,j1,j2,k1,k2)
2731
2732	StoredStart(1:NDim) = PatchStart(1:NDim)
2733	call ExtOrder(MemoryOrder,StoredStart,Status)
2734
2735	di=1
2736	if(FieldType == WRF_DOUBLE) di=2
2737	allocate(XField(di,x1:x2,y1:y2,z1:z2), STAT=stat)
2738	if(stat/= 0) then
2739	Status = WRF_ERR_FATAL_ALLOCATION_ERROR
2740	write(msg,*) 'Fatal ALLOCATION ERROR in ',__FILE__,', line', __LINE__
2741	call wrf_debug ( FATAL , msg)
2742	return
2743	endif
2744	call FieldIO('read',DataHandle,DateStr,StoredStart,Length,MemoryOrder, &
2745	FieldType,NCID,VarID,XField,Status)
2746	if(Status /= WRF_NO_ERR) then
2747	write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
2748	call wrf_debug ( WARN , TRIM(msg))
2749	return
2750	endif
2751	call Transpose('read',MemoryOrder,di, Field,l1,l2,m1,m2,n1,n2 &
2752	,XField,x1,x2,y1,y2,z1,z2 &
2753	,i1,i2,j1,j2,k1,k2 )
2754	deallocate(XField, STAT=stat)
2755	if(stat/= 0) then
2756	Status = WRF_ERR_FATAL_DEALLOCATION_ERR
2757	write(msg,*) 'Fatal DEALLOCATION ERROR in ',__FILE__,', line', __LINE__
2758	call wrf_debug ( FATAL , msg)
2759	return
2760	endif
2761	else
2762	Status = WRF_ERR_FATAL_BAD_FILE_STATUS
2763	write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
2764	call wrf_debug ( FATAL , msg)
2765	endif
2766	DH%first_operation = .FALSE.
2767	return
2768	end subroutine ext_pnc_read_field
2769
2770	subroutine ext_pnc_inquire_opened( DataHandle, FileName , FileStatus, Status )
2771	use wrf_data_pnc
2772	use ext_pnc_support_routines
2773	implicit none
2774	include 'wrf_status_codes.h'
2775	integer ,intent(in) :: DataHandle
2776	character() ,intent(in) :: FileName
2777	integer ,intent(out) :: FileStatus
2778	integer ,intent(out) :: Status
2779	type(wrf_data_handle) ,pointer :: DH
2780
2781	call GetDH(DataHandle,DH,Status)
2782	if(Status /= WRF_NO_ERR) then
2783	FileStatus = WRF_FILE_NOT_OPENED
2784	return
2785	endif
2786	if(FileName /= DH%FileName) then
2787	FileStatus = WRF_FILE_NOT_OPENED
2788	else
2789	FileStatus = DH%FileStatus
2790	endif
2791	Status = WRF_NO_ERR
2792	return
2793	end subroutine ext_pnc_inquire_opened
2794
2795	subroutine ext_pnc_inquire_filename( Datahandle, FileName, FileStatus, Status )
2796	use wrf_data_pnc
2797	use ext_pnc_support_routines
2798	implicit none
2799	include 'wrf_status_codes.h'
2800	integer ,intent(in) :: DataHandle
2801	character() ,intent(out) :: FileName
2802	integer ,intent(out) :: FileStatus
2803	integer ,intent(out) :: Status
2804	type(wrf_data_handle) ,pointer :: DH
2805	FileStatus = WRF_FILE_NOT_OPENED
2806	call GetDH(DataHandle,DH,Status)
2807	if(Status /= WRF_NO_ERR) then
2808	write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
2809	call wrf_debug ( WARN , TRIM(msg))
2810	return
2811	endif
2812	FileName = DH%FileName
2813	FileStatus = DH%FileStatus
2814	Status = WRF_NO_ERR
2815	return
2816	end subroutine ext_pnc_inquire_filename
2817
2818	subroutine ext_pnc_set_time(DataHandle, DateStr, Status)
2819	use wrf_data_pnc
2820	use ext_pnc_support_routines
2821	implicit none
2822	include 'wrf_status_codes.h'
2823	integer ,intent(in) :: DataHandle
2824	character() ,intent(in) :: DateStr
2825	integer ,intent(out) :: Status
2826	type(wrf_data_handle) ,pointer :: DH
2827	integer :: i
2828
2829	call DateCheck(DateStr,Status)
2830	if(Status /= WRF_NO_ERR) then
2831	write(msg,*) 'Warning DATE STRING ERROR in ',__FILE__,', line', __LINE__
2832	call wrf_debug ( WARN , TRIM(msg))
2833	return
2834	endif
2835	call GetDH(DataHandle,DH,Status)
2836	if(Status /= WRF_NO_ERR) then
2837	write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
2838	call wrf_debug ( WARN , TRIM(msg))
2839	return
2840	endif
2841	if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
2842	Status = WRF_WARN_FILE_NOT_OPENED
2843	write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
2844	call wrf_debug ( WARN , TRIM(msg))
2845	elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
2846	Status = WRF_WARN_FILE_NOT_COMMITTED
2847	write(msg,*) 'Warning FILE NOT COMMITTED in ',__FILE__,', line', __LINE__
2848	call wrf_debug ( WARN , TRIM(msg))
2849	elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
2850	Status = WRF_WARN_READ_WONLY_FILE
2851	write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__
2852	call wrf_debug ( WARN , TRIM(msg))
2853	elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
2854	do i=1,MaxTimes
2855	if(DH%Times(i)==DateStr) then
2856	DH%CurrentTime = i
2857	exit
2858	endif
2859	if(i==MaxTimes) then
2860	Status = WRF_WARN_TIME_NF
2861	return
2862	endif
2863	enddo
2864	DH%CurrentVariable = 0
2865	Status = WRF_NO_ERR
2866	else
2867	Status = WRF_ERR_FATAL_BAD_FILE_STATUS
2868	write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
2869	call wrf_debug ( FATAL , msg)
2870	endif
2871	return
2872	end subroutine ext_pnc_set_time
2873
2874	subroutine ext_pnc_get_next_time(DataHandle, DateStr, Status)
2875	use wrf_data_pnc
2876	use ext_pnc_support_routines
2877	implicit none
2878	include 'wrf_status_codes.h'
2879	integer ,intent(in) :: DataHandle
2880	character() ,intent(out) :: DateStr
2881	integer ,intent(out) :: Status
2882	type(wrf_data_handle) ,pointer :: DH
2883
2884	call GetDH(DataHandle,DH,Status)
2885	if(Status /= WRF_NO_ERR) then
2886	write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
2887	call wrf_debug ( WARN , TRIM(msg))
2888	return
2889	endif
2890	if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
2891	Status = WRF_WARN_FILE_NOT_OPENED
2892	write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
2893	call wrf_debug ( WARN , TRIM(msg))
2894	elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
2895	Status = WRF_WARN_DRYRUN_READ
2896	write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__
2897	call wrf_debug ( WARN , TRIM(msg))
2898	elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
2899	Status = WRF_WARN_READ_WONLY_FILE
2900	write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__
2901	call wrf_debug ( WARN , TRIM(msg))
2902	elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ .OR. DH%FileStatus == WRF_FILE_OPENED_FOR_UPDATE ) then
2903	if(DH%CurrentTime >= DH%NumberTimes) then
2904	write(msg,*) 'Warning ext_pnc_get_next_time: DH%CurrentTime >= DH%NumberTimes ',DH%CurrentTime,DH%NumberTimes
2905	call wrf_debug ( WARN , TRIM(msg))
2906	Status = WRF_WARN_TIME_EOF
2907	return
2908	endif
2909	DH%CurrentTime = DH%CurrentTime +1
2910	DateStr = DH%Times(DH%CurrentTime)
2911	DH%CurrentVariable = 0
2912	Status = WRF_NO_ERR
2913	else
2914	Status = WRF_ERR_FATAL_BAD_FILE_STATUS
2915	write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
2916	call wrf_debug ( FATAL , msg)
2917	endif
2918	return
2919	end subroutine ext_pnc_get_next_time
2920
2921	subroutine ext_pnc_get_previous_time(DataHandle, DateStr, Status)
2922	use wrf_data_pnc
2923	use ext_pnc_support_routines
2924	implicit none
2925	include 'wrf_status_codes.h'
2926	integer ,intent(in) :: DataHandle
2927	character() ,intent(out) :: DateStr
2928	integer ,intent(out) :: Status
2929	type(wrf_data_handle) ,pointer :: DH
2930
2931	call GetDH(DataHandle,DH,Status)
2932	if(Status /= WRF_NO_ERR) then
2933	write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
2934	call wrf_debug ( WARN , TRIM(msg))
2935	return
2936	endif
2937	if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
2938	Status = WRF_WARN_FILE_NOT_OPENED
2939	write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
2940	call wrf_debug ( WARN , TRIM(msg))
2941	elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
2942	Status = WRF_WARN_DRYRUN_READ
2943	write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__
2944	call wrf_debug ( WARN , TRIM(msg))
2945	elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
2946	Status = WRF_WARN_READ_WONLY_FILE
2947	write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__
2948	call wrf_debug ( WARN , TRIM(msg))
2949	elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ) then
2950	if(DH%CurrentTime.GT.0) then
2951	DH%CurrentTime = DH%CurrentTime -1
2952	endif
2953	DateStr = DH%Times(DH%CurrentTime)
2954	DH%CurrentVariable = 0
2955	Status = WRF_NO_ERR
2956	else
2957	Status = WRF_ERR_FATAL_BAD_FILE_STATUS
2958	write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
2959	call wrf_debug ( FATAL , msg)
2960	endif
2961	return
2962	end subroutine ext_pnc_get_previous_time
2963
2964	subroutine ext_pnc_get_next_var(DataHandle, VarName, Status)
2965	use wrf_data_pnc
2966	use ext_pnc_support_routines
2967	implicit none
2968	include 'wrf_status_codes.h'
2969	# include "pnetcdf.inc"
2970	integer ,intent(in) :: DataHandle
2971	character() ,intent(out) :: VarName
2972	integer ,intent(out) :: Status
2973	type(wrf_data_handle) ,pointer :: DH
2974	integer :: stat
2975	character (80) :: Name
2976
2977	call GetDH(DataHandle,DH,Status)
2978	if(Status /= WRF_NO_ERR) then
2979	write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
2980	call wrf_debug ( WARN , TRIM(msg))
2981	return
2982	endif
2983	if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
2984	Status = WRF_WARN_FILE_NOT_OPENED
2985	write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
2986	call wrf_debug ( WARN , TRIM(msg))
2987	elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
2988	Status = WRF_WARN_DRYRUN_READ
2989	write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__
2990	call wrf_debug ( WARN , TRIM(msg))
2991	elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
2992	Status = WRF_WARN_READ_WONLY_FILE
2993	write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__
2994	call wrf_debug ( WARN , TRIM(msg))
2995	elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ .OR. DH%FileStatus == WRF_FILE_OPENED_FOR_UPDATE) then
2996
2997	DH%CurrentVariable = DH%CurrentVariable +1
2998	if(DH%CurrentVariable > DH%NumVars) then
2999	Status = WRF_WARN_VAR_EOF
3000	return
3001	endif
3002	VarName = DH%VarNames(DH%CurrentVariable)
3003	Status = WRF_NO_ERR
3004	else
3005	Status = WRF_ERR_FATAL_BAD_FILE_STATUS
3006	write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
3007	call wrf_debug ( FATAL , msg)
3008	endif
3009	return
3010	end subroutine ext_pnc_get_next_var
3011
3012	subroutine ext_pnc_end_of_frame(DataHandle, Status)
3013	use wrf_data_pnc
3014	use ext_pnc_support_routines
3015	implicit none
3016	# include "pnetcdf.inc"
3017	include 'wrf_status_codes.h'
3018	integer ,intent(in) :: DataHandle
3019	integer ,intent(out) :: Status
3020	type(wrf_data_handle) ,pointer :: DH
3021
3022	call GetDH(DataHandle,DH,Status)
3023	return
3024	end subroutine ext_pnc_end_of_frame
3025
3026	! NOTE: For scalar variables NDim is set to zero and DomainStart and
3027	! NOTE: DomainEnd are left unmodified.
3028	subroutine ext_pnc_get_var_info(DataHandle,Name,NDim,MemoryOrder,Stagger,DomainStart,DomainEnd,WrfType,Status)
3029	use wrf_data_pnc
3030	use ext_pnc_support_routines
3031	implicit none
3032	# include "pnetcdf.inc"
3033	include 'wrf_status_codes.h'
3034	integer ,intent(in) :: DataHandle
3035	character() ,intent(in) :: Name
3036	integer ,intent(out) :: NDim
3037	character() ,intent(out) :: MemoryOrder
3038	character() :: Stagger ! Dummy for now
3039	integer ,dimension(*) ,intent(out) :: DomainStart, DomainEnd
3040	integer ,intent(out) :: WrfType
3041	integer ,intent(out) :: Status
3042	type(wrf_data_handle) ,pointer :: DH
3043	integer :: VarID
3044	integer ,dimension(NVarDims) :: VDimIDs
3045	integer :: j
3046	integer :: stat
3047	integer :: XType
3048
3049	call GetDH(DataHandle,DH,Status)
3050	if(Status /= WRF_NO_ERR) then
3051	write(msg,*) 'Warning Status = ',Status,' in ',__FILE__,', line', __LINE__
3052	call wrf_debug ( WARN , TRIM(msg))
3053	return
3054	endif
3055	if(DH%FileStatus == WRF_FILE_NOT_OPENED) then
3056	Status = WRF_WARN_FILE_NOT_OPENED
3057	write(msg,*) 'Warning FILE NOT OPENED in ',__FILE__,', line', __LINE__
3058	call wrf_debug ( WARN , TRIM(msg))
3059	return
3060	elseif(DH%FileStatus == WRF_FILE_OPENED_NOT_COMMITTED) then
3061	Status = WRF_WARN_DRYRUN_READ
3062	write(msg,*) 'Warning DRYRUN READ in ',__FILE__,', line', __LINE__
3063	call wrf_debug ( WARN , TRIM(msg))
3064	return
3065	elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_WRITE) then
3066	Status = WRF_WARN_READ_WONLY_FILE
3067	write(msg,*) 'Warning READ WRITE ONLY FILE in ',__FILE__,', line', __LINE__
3068	call wrf_debug ( WARN , TRIM(msg))
3069	return
3070	elseif(DH%FileStatus == WRF_FILE_OPENED_FOR_READ .OR. DH%FileStatus == WRF_FILE_OPENED_FOR_UPDATE) then
3071	stat = NFMPI_INQ_VARID(DH%NCID,Name,VarID)
3072	call netcdf_err(stat,Status)
3073	if(Status /= WRF_NO_ERR) then
3074	write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
3075	call wrf_debug ( WARN , TRIM(msg))
3076	return
3077	endif
3078	stat = NFMPI_INQ_VARTYPE(DH%NCID,VarID,XType)
3079	call netcdf_err(stat,Status)
3080	if(Status /= WRF_NO_ERR) then
3081	write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
3082	call wrf_debug ( WARN , TRIM(msg))
3083	return
3084	endif
3085	stat = NFMPI_GET_ATT_INT(DH%NCID,VarID,'FieldType',WrfType)
3086	call netcdf_err(stat,Status)
3087	if(Status /= WRF_NO_ERR) then
3088	write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
3089	call wrf_debug ( WARN , TRIM(msg))
3090	return
3091	endif
3092	select case (XType)
3093	case (NF_BYTE)
3094	Status = WRF_WARN_BAD_DATA_TYPE
3095	write(msg,*) 'Warning BYTE IS BAD DATA TYPE in ',__FILE__,', line', __LINE__
3096	call wrf_debug ( WARN , TRIM(msg))
3097	return
3098	case (NF_CHAR)
3099	Status = WRF_WARN_BAD_DATA_TYPE
3100	write(msg,*) 'Warning CHAR IS BAD DATA TYPE in ',__FILE__,', line', __LINE__
3101	call wrf_debug ( WARN , TRIM(msg))
3102	return
3103	case (NF_SHORT)
3104	Status = WRF_WARN_BAD_DATA_TYPE
3105	write(msg,*) 'Warning SHORT IS BAD DATA TYPE in ',__FILE__,', line', __LINE__
3106	call wrf_debug ( WARN , TRIM(msg))
3107	return
3108	case (NF_INT)
3109	if(WrfType /= WRF_INTEGER .and. WrfType /= WRF_LOGICAL) then
3110	Status = WRF_WARN_BAD_DATA_TYPE
3111	write(msg,*) 'Warning BAD DATA TYPE in ',__FILE__,', line', __LINE__
3112	call wrf_debug ( WARN , TRIM(msg))
3113	return
3114	endif
3115	case (NF_FLOAT)
3116	if(WrfType /= WRF_REAL) then
3117	Status = WRF_WARN_BAD_DATA_TYPE
3118	write(msg,*) 'Warning BAD DATA TYPE in ',__FILE__,', line', __LINE__
3119	call wrf_debug ( WARN , TRIM(msg))
3120	return
3121	endif
3122	case (NF_DOUBLE)
3123	if(WrfType /= WRF_DOUBLE) then
3124	Status = WRF_WARN_BAD_DATA_TYPE
3125	write(msg,*) 'Warning BAD DATA TYPE in ',__FILE__,', line', __LINE__
3126	call wrf_debug ( WARN , TRIM(msg))
3127	return
3128	endif
3129	case default
3130	Status = WRF_WARN_DATA_TYPE_NOT_FOUND
3131	write(msg,*) 'Warning DATA TYPE NOT FOUND in ',__FILE__,', line', __LINE__
3132	call wrf_debug ( WARN , TRIM(msg))
3133	return
3134	end select
3135
3136	stat = NFMPI_GET_ATT_TEXT(DH%NCID,VarID,'MemoryOrder',MemoryOrder)
3137	call netcdf_err(stat,Status)
3138	if(Status /= WRF_NO_ERR) then
3139	write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
3140	call wrf_debug ( WARN , TRIM(msg))
3141	return
3142	endif
3143	call GetDim(MemoryOrder,NDim,Status)
3144	if(Status /= WRF_NO_ERR) then
3145	write(msg,*) 'Warning BAD MEMORY ORDER ',TRIM(MemoryOrder),' in ',__FILE__,', line', __LINE__
3146	call wrf_debug ( WARN , TRIM(msg))
3147	return
3148	endif
3149	stat = NFMPI_INQ_VARDIMID(DH%NCID,VarID,VDimIDs)
3150	call netcdf_err(stat,Status)
3151	if(Status /= WRF_NO_ERR) then
3152	write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
3153	call wrf_debug ( WARN , TRIM(msg))
3154	return
3155	endif
3156	do j = 1, NDim
3157	DomainStart(j) = 1
3158	stat = NFMPI_INQ_DIMLEN(DH%NCID,VDimIDs(j),DomainEnd(j))
3159	call netcdf_err(stat,Status)
3160	if(Status /= WRF_NO_ERR) then
3161	write(msg,*) 'NetCDF error in ',__FILE__,', line', __LINE__
3162	call wrf_debug ( WARN , TRIM(msg))
3163	return
3164	endif
3165	enddo
3166	else
3167	Status = WRF_ERR_FATAL_BAD_FILE_STATUS
3168	write(msg,*) 'Fatal error BAD FILE STATUS in ',__FILE__,', line', __LINE__
3169	call wrf_debug ( FATAL , msg)
3170	endif
3171	return
3172	end subroutine ext_pnc_get_var_info
3173
3174	subroutine ext_pnc_warning_str( Code, ReturnString, Status)
3175	use wrf_data_pnc
3176	use ext_pnc_support_routines
3177	implicit none
3178	# include "pnetcdf.inc"
3179	include 'wrf_status_codes.h'
3180
3181	integer , intent(in) ::Code
3182	character (), intent(out) :: ReturnString
3183	integer, intent(out) ::Status
3184
3185	SELECT CASE (Code)
3186	CASE (0)
3187	ReturnString='No error'
3188	Status=WRF_NO_ERR
3189	return
3190	CASE (-1)
3191	ReturnString= 'File not found (or file is incomplete)'
3192	Status=WRF_NO_ERR
3193	return
3194	CASE (-2)
3195	ReturnString='Metadata not found'
3196	Status=WRF_NO_ERR
3197	return
3198	CASE (-3)
3199	ReturnString= 'Timestamp not found'
3200	Status=WRF_NO_ERR
3201	return
3202	CASE (-4)
3203	ReturnString= 'No more timestamps'
3204	Status=WRF_NO_ERR
3205	return
3206	CASE (-5)
3207	ReturnString= 'Variable not found'
3208	Status=WRF_NO_ERR
3209	return
3210	CASE (-6)
3211	ReturnString= 'No more variables for the current time'
3212	Status=WRF_NO_ERR
3213	return
3214	CASE (-7)
3215	ReturnString= 'Too many open files'
3216	Status=WRF_NO_ERR
3217	return
3218	CASE (-8)
3219	ReturnString= 'Data type mismatch'
3220	Status=WRF_NO_ERR
3221	return
3222	CASE (-9)
3223	ReturnString= 'Attempt to write read-only file'
3224	Status=WRF_NO_ERR
3225	return
3226	CASE (-10)
3227	ReturnString= 'Attempt to read write-only file'
3228	Status=WRF_NO_ERR
3229	return
3230	CASE (-11)
3231	ReturnString= 'Attempt to access unopened file'
3232	Status=WRF_NO_ERR
3233	return
3234	CASE (-12)
3235	ReturnString= 'Attempt to do 2 trainings for 1 variable'
3236	Status=WRF_NO_ERR
3237	return
3238	CASE (-13)
3239	ReturnString= 'Attempt to read past EOF'
3240	Status=WRF_NO_ERR
3241	return
3242	CASE (-14)
3243	ReturnString= 'Bad data handle'
3244	Status=WRF_NO_ERR
3245	return
3246	CASE (-15)
3247	ReturnString= 'Write length not equal to training length'
3248	Status=WRF_NO_ERR
3249	return
3250	CASE (-16)
3251	ReturnString= 'More dimensions requested than training'
3252	Status=WRF_NO_ERR
3253	return
3254	CASE (-17)
3255	ReturnString= 'Attempt to read more data than exists'
3256	Status=WRF_NO_ERR
3257	return
3258	CASE (-18)
3259	ReturnString= 'Input dimensions inconsistent'
3260	Status=WRF_NO_ERR
3261	return
3262	CASE (-19)
3263	ReturnString= 'Input MemoryOrder not recognized'
3264	Status=WRF_NO_ERR
3265	return
3266	CASE (-20)
3267	ReturnString= 'A dimension name with 2 different lengths'
3268	Status=WRF_NO_ERR
3269	return
3270	CASE (-21)
3271	ReturnString= 'String longer than provided storage'
3272	Status=WRF_NO_ERR
3273	return
3274	CASE (-22)
3275	ReturnString= 'Function not supportable'
3276	Status=WRF_NO_ERR
3277	return
3278	CASE (-23)
3279	ReturnString= 'Package implements this routine as NOOP'
3280	Status=WRF_NO_ERR
3281	return
3282
3283	!netcdf-specific warning messages
3284	CASE (-1007)
3285	ReturnString= 'Bad data type'
3286	Status=WRF_NO_ERR
3287	return
3288	CASE (-1008)
3289	ReturnString= 'File not committed'
3290	Status=WRF_NO_ERR
3291	return
3292	CASE (-1009)
3293	ReturnString= 'File is opened for reading'
3294	Status=WRF_NO_ERR
3295	return
3296	CASE (-1011)
3297	ReturnString= 'Attempt to write metadata after open commit'
3298	Status=WRF_NO_ERR
3299	return
3300	CASE (-1010)
3301	ReturnString= 'I/O not initialized'
3302	Status=WRF_NO_ERR
3303	return
3304	CASE (-1012)
3305	ReturnString= 'Too many variables requested'
3306	Status=WRF_NO_ERR
3307	return
3308	CASE (-1013)
3309	ReturnString= 'Attempt to close file during a dry run'
3310	Status=WRF_NO_ERR
3311	return
3312	CASE (-1014)
3313	ReturnString= 'Date string not 19 characters in length'
3314	Status=WRF_NO_ERR
3315	return
3316	CASE (-1015)
3317	ReturnString= 'Attempt to read zero length words'
3318	Status=WRF_NO_ERR
3319	return
3320	CASE (-1016)
3321	ReturnString= 'Data type not found'
3322	Status=WRF_NO_ERR
3323	return
3324	CASE (-1017)
3325	ReturnString= 'Badly formatted date string'
3326	Status=WRF_NO_ERR
3327	return
3328	CASE (-1018)
3329	ReturnString= 'Attempt at read during a dry run'
3330	Status=WRF_NO_ERR
3331	return
3332	CASE (-1019)
3333	ReturnString= 'Attempt to get zero words'
3334	Status=WRF_NO_ERR
3335	return
3336	CASE (-1020)
3337	ReturnString= 'Attempt to put zero length words'
3338	Status=WRF_NO_ERR
3339	return
3340	CASE (-1021)
3341	ReturnString= 'NetCDF error'
3342	Status=WRF_NO_ERR
3343	return
3344	CASE (-1022)
3345	ReturnString= 'Requested length <= 1'
3346	Status=WRF_NO_ERR
3347	return
3348	CASE (-1023)
3349	ReturnString= 'More data available than requested'
3350	Status=WRF_NO_ERR
3351	return
3352	CASE (-1024)
3353	ReturnString= 'New date less than previous date'
3354	Status=WRF_NO_ERR
3355	return
3356
3357	CASE DEFAULT
3358	ReturnString= 'This warning code is not supported or handled directly by WRF and NetCDF. &
3359	& Might be an erroneous number, or specific to an i/o package other than NetCDF; you may need &
3360	& to be calling a package-specific routine to return a message for this warning code.'
3361	Status=WRF_NO_ERR
3362	END SELECT
3363
3364	return
3365	end subroutine ext_pnc_warning_str
3366
3367
3368	!returns message string for all WRF and netCDF warning/error status codes
3369	!Other i/o packages must provide their own routines to return their own status messages
3370	subroutine ext_pnc_error_str( Code, ReturnString, Status)
3371	use wrf_data_pnc
3372	use ext_pnc_support_routines
3373	implicit none
3374	# include "pnetcdf.inc"
3375	include 'wrf_status_codes.h'
3376
3377	integer , intent(in) ::Code
3378	character (), intent(out) :: ReturnString
3379	integer, intent(out) ::Status
3380
3381	SELECT CASE (Code)
3382	CASE (-100)
3383	ReturnString= 'Allocation Error'
3384	Status=WRF_NO_ERR
3385	return
3386	CASE (-101)
3387	ReturnString= 'Deallocation Error'
3388	Status=WRF_NO_ERR
3389	return
3390	CASE (-102)
3391	ReturnString= 'Bad File Status'
3392	Status=WRF_NO_ERR
3393	return
3394	CASE (-1004)
3395	ReturnString= 'Variable on disk is not 3D'
3396	Status=WRF_NO_ERR
3397	return
3398	CASE (-1005)
3399	ReturnString= 'Metadata on disk is not 1D'
3400	Status=WRF_NO_ERR
3401	return
3402	CASE (-1006)
3403	ReturnString= 'Time dimension too small'
3404	Status=WRF_NO_ERR
3405	return
3406	CASE DEFAULT
3407	ReturnString= 'This error code is not supported or handled directly by WRF and NetCDF. &
3408	& Might be an erroneous number, or specific to an i/o package other than NetCDF; you may need &
3409	& to be calling a package-specific routine to return a message for this error code.'
3410	Status=WRF_NO_ERR
3411	END SELECT
3412
3413	return
3414	end subroutine ext_pnc_error_str

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

Download in other formats:

Original Format