Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

wrf_io.F90 @ 3567

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

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

Download in other formats:

Original Format