Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

wrf_io.F90 @ 3532

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

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

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

Download in other formats:

Original Format