Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Blame
Revision Log

wrf_io.F90 @ 2756

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

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

Download in other formats:

Original Format