Context Navigation

← Previous Revision
Latest Revision
Next Revision →
Normal
Revision Log

module_internal_header_util.F @ 2760

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

Rev	Line
[2759]	1	MODULE module_internal_header_util
	2
	3	!<DESCRIPTION>
	4	!<PRE>
	5	! Subroutines defined in this module are used to generate (put together) and get (take apart)
	6	! data headers stored in the form of integer vectors.
	7	!
	8	! Data headers serve two purposes:
	9	! - Provide a package-independent metadata storage and retrieval mechanism
	10	! for I/O packages that do not support native metadata.
	11	! - Provide a mechanism for communicating I/O commands from compute
	12	! tasks to quilt tasks when I/O quilt servers are enabled.
	13	!
	14	! Within a data header, character strings are stored one character per integer.
	15	! The number of characters is stored immediately before the first character of
	16	! each string.
	17	!
	18	! In an I/O package that does not support native metadata, routines
	19	! int_gen_*_header() are called to pack information into data headers that
	20	! are then written to files. Routines int_get_*_header() are called to
	21	! extract information from a data headers after they have been read from a
	22	! file.
	23	!
	24	! When I/O quilt server tasks are used, routines int_gen_*_header()
	25	! are called by compute tasks to pack information into data headers
	26	! (commands) that are then sent to the I/O quilt servers. Routines
	27	! int_get_*_header() are called by I/O quilt servers to extract
	28	! information from data headers (commands) received from the compute
	29	! tasks.
	30	!
	31	!</PRE>
	32	!</DESCRIPTION>
	33
	34	INTERFACE int_get_ti_header
	35	MODULE PROCEDURE int_get_ti_header_integer, int_get_ti_header_real
	36	END INTERFACE
	37	INTERFACE int_gen_ti_header
	38	MODULE PROCEDURE int_gen_ti_header_integer, int_gen_ti_header_real
	39	END INTERFACE
	40	INTERFACE int_get_td_header
	41	MODULE PROCEDURE int_get_td_header_integer, int_get_td_header_real
	42	END INTERFACE
	43	INTERFACE int_gen_td_header
	44	MODULE PROCEDURE int_gen_td_header_integer, int_gen_td_header_real
	45	END INTERFACE
	46
	47	PRIVATE :: int_pack_string, int_unpack_string
	48
	49	CONTAINS
	50	!!!!!!!!!!!!! header manipulation routines !!!!!!!!!!!!!!!
	51
	52	INTEGER FUNCTION get_hdr_tag( hdrbuf )
	53	IMPLICIT NONE
	54	INTEGER, INTENT(IN) :: hdrbuf(*)
	55	get_hdr_tag = hdrbuf(2)
	56	RETURN
	57	END FUNCTION get_hdr_tag
	58
	59	INTEGER FUNCTION get_hdr_rec_size( hdrbuf )
	60	IMPLICIT NONE
	61	INTEGER, INTENT(IN) :: hdrbuf(*)
	62	get_hdr_rec_size = hdrbuf(1)
	63	RETURN
	64	END FUNCTION get_hdr_rec_size
	65
	66	SUBROUTINE int_gen_write_field_header ( hdrbuf, hdrbufsize, itypesize, ftypesize, &
	67	DataHandle , DateStr , VarName , Dummy , FieldType , Comm , IOComm, &
	68	DomainDesc , MemoryOrder , Stagger , DimNames , &
	69	DomainStart , DomainEnd , &
	70	MemoryStart , MemoryEnd , &
	71	PatchStart , PatchEnd )
	72	!<DESCRIPTION>
	73	!<PRE>
	74	! Items and their starting locations within a "write field" data header.
	75	! Assume that the data header is stored in integer vector "hdrbuf":
	76	! hdrbuf(1) = hdrbufsize
	77	! hdrbuf(2) = headerTag
	78	! hdrbuf(3) = ftypesize
	79	! hdrbuf(4) = DataHandle
	80	! hdrbuf(5) = LEN(TRIM(DateStr))
	81	! hdrbuf(6:5+n1) = DateStr ! n1 = LEN(TRIM(DateStr)) + 1
	82	! hdrbuf(6+n1) = LEN(TRIM(VarName))
	83	! hdrbuf(7+n1:6+n1+n2) = VarName ! n2 = LEN(TRIM(VarName)) + 1
	84	! hdrbuf(7+n1+n2) = FieldType
	85	! hdrbuf(8+n1+n2) = LEN(TRIM(MemoryOrder))
	86	! hdrbuf(9+n1+n2:8+n1+n2+n3) = MemoryOrder ! n3 = LEN(TRIM(MemoryOrder)) + 1
	87	! hdrbuf(9+n1+n2+n3) = LEN(TRIM(Stagger))
	88	! hdrbuf(9+n1+n2+n3:8+n1+n2+n3+n4) = Stagger ! n4 = LEN(TRIM(Stagger)) + 1
	89	! hdrbuf(9+n1+n2+n3+n4) = LEN(TRIM(DimNames(1)))
	90	! hdrbuf(9+n1+n2+n3+n4:8+n1+n2+n3+n4+n5) = DimNames(1) ! n5 = LEN(TRIM(DimNames(1))) + 1
	91	! hdrbuf(9+n1+n2+n3+n4+n5) = LEN(TRIM(DimNames(2)))
	92	! hdrbuf(9+n1+n2+n3+n4+n5:8+n1+n2+n3+n4+n5+n6) = DimNames(2) ! n6 = LEN(TRIM(DimNames(2))) + 1
	93	! hdrbuf(9+n1+n2+n3+n4+n5+n6) = LEN(TRIM(DimNames(3)))
	94	! hdrbuf(9+n1+n2+n3+n4+n5+n6:8+n1+n2+n3+n4+n5+n6+n7) = DimNames(3) ! n7 = LEN(TRIM(DimNames(3))) + 1
	95	! hdrbuf(9+n1+n2+n3+n4+n5+n6+n7) = DomainStart(1)
	96	! hdrbuf(10+n1+n2+n3+n4+n5+n6+n7) = DomainStart(2)
	97	! hdrbuf(11+n1+n2+n3+n4+n5+n6+n7) = DomainStart(3)
	98	! hdrbuf(12+n1+n2+n3+n4+n5+n6+n7) = DomainEnd(1)
	99	! hdrbuf(13+n1+n2+n3+n4+n5+n6+n7) = DomainEnd(2)
	100	! hdrbuf(14+n1+n2+n3+n4+n5+n6+n7) = DomainEnd(3)
	101	! hdrbuf(15+n1+n2+n3+n4+n5+n6+n7) = PatchStart(1)
	102	! hdrbuf(16+n1+n2+n3+n4+n5+n6+n7) = PatchStart(2)
	103	! hdrbuf(17+n1+n2+n3+n4+n5+n6+n7) = PatchStart(3)
	104	! hdrbuf(18+n1+n2+n3+n4+n5+n6+n7) = PatchEnd(1)
	105	! hdrbuf(19+n1+n2+n3+n4+n5+n6+n7) = PatchEnd(2)
	106	! hdrbuf(20+n1+n2+n3+n4+n5+n6+n7) = PatchEnd(3)
	107	! hdrbuf(21+n1+n2+n3+n4+n5+n6+n7) = DomainDesc
	108	!
	109	! Further details for some items:
	110	! hdrbufsize: Size of this data header in bytes.
	111	! headerTag: "Header tag" that tells the I/O quilt servers what kind of
	112	! header this is. For a "write field" header it must be set to
	113	! int_field. See file intio_tags.h for a complete list of
	114	! these tags.
	115	! ftypesize: Size of field data type in bytes.
	116	! DataHandle: Descriptor for an open data set.
	117	! DomainDesc: Additional argument that may be used by some packages as a
	118	! package-specific domain descriptor.
	119	! Other items are described in detail in the "WRF I/O and Model Coupling API
	120	! Specification".
	121	!
	122	!</PRE>
	123	!</DESCRIPTION>
	124	IMPLICIT NONE
	125	#include "intio_tags.h"
	126	INTEGER, INTENT(INOUT) :: hdrbuf(*)
	127	INTEGER, INTENT(INOUT) :: hdrbufsize
	128	INTEGER, INTENT(INOUT) :: itypesize, ftypesize
	129	INTEGER , INTENT(IN) :: DataHandle
	130	CHARACTER(), INTENT(IN) :: DateStr
	131	CHARACTER(), INTENT(IN) :: VarName
	132	REAL, DIMENSION(*) :: Dummy
	133	INTEGER ,intent(in) :: FieldType
	134	INTEGER ,intent(inout) :: Comm
	135	INTEGER ,intent(inout) :: IOComm
	136	INTEGER ,intent(in) :: DomainDesc
	137	CHARACTER() ,intent(in) :: MemoryOrder
	138	CHARACTER() ,intent(in) :: Stagger
	139	CHARACTER() , dimension (*) ,intent(in) :: DimNames
	140	INTEGER ,dimension(*) ,intent(in) :: DomainStart, DomainEnd
	141	INTEGER ,dimension(*) ,intent(in) :: MemoryStart, MemoryEnd
	142	INTEGER ,dimension(*) ,intent(in) :: PatchStart, PatchEnd
	143
	144	INTEGER i, n
	145
	146
	147	hdrbuf(1) = 0 ! deferred -- this will be length of header
	148	hdrbuf(2) = int_field
	149	hdrbuf(3) = ftypesize
	150
	151	i = 4
	152	hdrbuf(i) = DataHandle ; i = i+1
	153	call int_pack_string( DateStr, hdrbuf(i), n ) ; i = i + n
	154	call int_pack_string( VarName, hdrbuf(i), n ) ; i = i + n
	155	hdrbuf(i) = FieldType ; i = i+1
	156	call int_pack_string( MemoryOrder, hdrbuf(i), n ) ; i = i + n
	157	call int_pack_string( Stagger, hdrbuf(i), n ) ; i = i + n
	158	call int_pack_string( DimNames(1), hdrbuf(i), n ) ; i = i + n
	159	call int_pack_string( DimNames(2), hdrbuf(i), n ) ; i = i + n
	160	call int_pack_string( DimNames(3), hdrbuf(i), n ) ; i = i + n
	161	hdrbuf(i) = DomainStart(1) ; i = i+1
	162	hdrbuf(i) = DomainStart(2) ; i = i+1
	163	hdrbuf(i) = DomainStart(3) ; i = i+1
	164	hdrbuf(i) = DomainEnd(1) ; i = i+1
	165	hdrbuf(i) = DomainEnd(2) ; i = i+1
	166	hdrbuf(i) = DomainEnd(3) ; i = i+1
	167	hdrbuf(i) = PatchStart(1) ; i = i+1
	168	hdrbuf(i) = PatchStart(2) ; i = i+1
	169	hdrbuf(i) = PatchStart(3) ; i = i+1
	170	hdrbuf(i) = PatchEnd(1) ; i = i+1
	171	hdrbuf(i) = PatchEnd(2) ; i = i+1
	172	hdrbuf(i) = PatchEnd(3) ; i = i+1
	173	hdrbuf(i) = DomainDesc ; i = i+1
	174
	175	hdrbufsize = (i-1) * itypesize ! return the number in bytes
	176	hdrbuf(1) = hdrbufsize
	177
	178	RETURN
	179	END SUBROUTINE int_gen_write_field_header
	180
	181
	182	SUBROUTINE int_get_write_field_header ( hdrbuf, hdrbufsize, itypesize, ftypesize, &
	183	DataHandle , DateStr , VarName , Dummy , FieldType , Comm , IOComm, &
	184	DomainDesc , MemoryOrder , Stagger , DimNames , &
	185	DomainStart , DomainEnd , &
	186	MemoryStart , MemoryEnd , &
	187	PatchStart , PatchEnd )
	188	!<DESCRIPTION>
	189	!<PRE>
	190	! See documentation block in int_gen_write_field_header() for
	191	! a description of a "write field" header.
	192	!</PRE>
	193	!</DESCRIPTION>
	194	IMPLICIT NONE
	195	#include "intio_tags.h"
	196	INTEGER, INTENT(INOUT) :: hdrbuf(*)
	197	INTEGER, INTENT(OUT) :: hdrbufsize
	198	INTEGER, INTENT(INOUT) :: itypesize, ftypesize
	199	INTEGER , INTENT(OUT) :: DataHandle
	200	CHARACTER(), INTENT(INOUT) :: DateStr
	201	CHARACTER(), INTENT(INOUT) :: VarName
	202	REAL, DIMENSION(*) :: Dummy
	203	INTEGER :: FieldType
	204	INTEGER :: Comm
	205	INTEGER :: IOComm
	206	INTEGER :: DomainDesc
	207	CHARACTER() :: MemoryOrder
	208	CHARACTER() :: Stagger
	209	CHARACTER() , dimension (*) :: DimNames
	210	INTEGER ,dimension(*) :: DomainStart, DomainEnd
	211	INTEGER ,dimension(*) :: MemoryStart, MemoryEnd
	212	INTEGER ,dimension(*) :: PatchStart, PatchEnd
	213	!Local
	214	CHARACTER*132 mess
	215	INTEGER i, n
	216
	217	hdrbufsize = hdrbuf(1)
	218	IF ( hdrbuf(2) .NE. int_field ) THEN
	219	write(mess,*)'int_get_write_field_header: hdrbuf(2) ne int_field ',hdrbuf(2),int_field
	220	CALL wrf_error_fatal ( mess )
	221	ENDIF
	222	ftypesize = hdrbuf(3)
	223
	224	i = 4
	225	DataHandle = hdrbuf(i) ; i = i+1
	226	call int_unpack_string( DateStr, hdrbuf(i), n ) ; i = i+n
	227	call int_unpack_string( VarName, hdrbuf(i), n ) ; i = i+n
	228	FieldType = hdrbuf(i) ; i = i+1
	229	call int_unpack_string( MemoryOrder, hdrbuf(i), n ) ; i = i+n
	230	call int_unpack_string( Stagger, hdrbuf(i), n ) ; i = i+n
	231	call int_unpack_string( DimNames(1), hdrbuf(i), n ) ; i = i+n
	232	call int_unpack_string( DimNames(2), hdrbuf(i), n ) ; i = i+n
	233	call int_unpack_string( DimNames(3), hdrbuf(i), n ) ; i = i+n
	234	DomainStart(1) = hdrbuf(i) ; i = i+1
	235	DomainStart(2) = hdrbuf(i) ; i = i+1
	236	DomainStart(3) = hdrbuf(i) ; i = i+1
	237	DomainEnd(1) = hdrbuf(i) ; i = i+1
	238	DomainEnd(2) = hdrbuf(i) ; i = i+1
	239	DomainEnd(3) = hdrbuf(i) ; i = i+1
	240	PatchStart(1) = hdrbuf(i) ; i = i+1
	241	PatchStart(2) = hdrbuf(i) ; i = i+1
	242	PatchStart(3) = hdrbuf(i) ; i = i+1
	243	PatchEnd(1) = hdrbuf(i) ; i = i+1
	244	PatchEnd(2) = hdrbuf(i) ; i = i+1
	245	PatchEnd(3) = hdrbuf(i) ; i = i+1
	246	DomainDesc = hdrbuf(i) ; i = i+1
	247
	248	RETURN
	249	END SUBROUTINE int_get_write_field_header
	250
	251	!!!!!!!!
	252
	253	!generate open for read header
	254	SUBROUTINE int_gen_ofr_header( hdrbuf, hdrbufsize, itypesize, &
	255	FileName, SysDepInfo, DataHandle )
	256	!<DESCRIPTION>
	257	!<PRE>
	258	! Items and their starting locations within a "open for read" data header.
	259	! Assume that the data header is stored in integer vector "hdrbuf":
	260	! hdrbuf(1) = hdrbufsize
	261	! hdrbuf(2) = headerTag
	262	! hdrbuf(3) = DataHandle
	263	! hdrbuf(4) = LEN(TRIM(FileName))
	264	! hdrbuf(5:4+n1) = FileName ! n1 = LEN(TRIM(FileName)) + 1
	265	! hdrbuf(5+n1) = LEN(TRIM(SysDepInfo))
	266	! hdrbuf(6+n1:5+n1+n2) = SysDepInfo ! n2 = LEN(TRIM(SysDepInfo)) + 1
	267	!
	268	! Further details for some items:
	269	! hdrbufsize: Size of this data header in bytes.
	270	! headerTag: "Header tag" that tells the I/O quilt servers what kind of
	271	! header this is. For an "open for read" header it must be set to
	272	! int_open_for_read. See file intio_tags.h for a complete list of
	273	! these tags.
	274	! DataHandle: Descriptor for an open data set.
	275	! FileName: File name.
	276	! SysDepInfo: System dependent information used for optional additional
	277	! I/O control information.
	278	! Other items are described in detail in the "WRF I/O and Model Coupling API
	279	! Specification".
	280	!
	281	!</PRE>
	282	!</DESCRIPTION>
	283	IMPLICIT NONE
	284	#include "intio_tags.h"
	285	INTEGER, INTENT(INOUT) :: hdrbuf(*)
	286	INTEGER, INTENT(OUT) :: hdrbufsize
	287	INTEGER, INTENT(INOUT) :: itypesize
	288	INTEGER , INTENT(IN) :: DataHandle
	289	CHARACTER(), INTENT(INOUT) :: FileName
	290	CHARACTER(), INTENT(INOUT) :: SysDepInfo
	291	!Local
	292	INTEGER i, n, i1
	293	!
	294	hdrbuf(1) = 0 !deferred
	295	hdrbuf(2) = int_open_for_read
	296	i = 3
	297	hdrbuf(i) = DataHandle ; i = i+1
	298
	299	call int_pack_string( TRIM(FileName), hdrbuf(i), n ) ; i = i + n
	300	call int_pack_string( TRIM(SysDepInfo), hdrbuf(i), n ) ; i = i + n
	301	hdrbufsize = (i-1) * itypesize ! return the number in bytes
	302	hdrbuf(1) = hdrbufsize
	303	RETURN
	304	END SUBROUTINE int_gen_ofr_header
	305
	306	!get open for read header
	307	SUBROUTINE int_get_ofr_header( hdrbuf, hdrbufsize, itypesize, &
	308	FileName, SysDepInfo, DataHandle )
	309	!<DESCRIPTION>
	310	!<PRE>
	311	! See documentation block in int_gen_ofr_header() for
	312	! a description of a "open for read" header.
	313	!</PRE>
	314	!</DESCRIPTION>
	315	IMPLICIT NONE
	316	#include "intio_tags.h"
	317	INTEGER, INTENT(INOUT) :: hdrbuf(*)
	318	INTEGER, INTENT(OUT) :: hdrbufsize
	319	INTEGER, INTENT(INOUT) :: itypesize
	320	INTEGER , INTENT(OUT) :: DataHandle
	321	CHARACTER(), INTENT(INOUT) :: FileName
	322	CHARACTER(), INTENT(INOUT) :: SysDepInfo
	323	!Local
	324	INTEGER i, n
	325	!
	326	hdrbufsize = hdrbuf(1)
	327	! IF ( hdrbuf(2) .NE. int_open_for_read ) THEN
	328	! CALL wrf_error_fatal ( "int_get_ofr_header: hdrbuf ne int_open_for_read")
	329	! ENDIF
	330	i = 3
	331	DataHandle = hdrbuf(i) ; i = i+1
	332	call int_unpack_string( FileName, hdrbuf(i), n ) ; i = i+n
	333	call int_unpack_string( SysDepInfo, hdrbuf(i), n ) ; i = i+n
	334	RETURN
	335	END SUBROUTINE int_get_ofr_header
	336
	337	!!!!!!!!
	338
	339	!generate open for write begin header
	340	SUBROUTINE int_gen_ofwb_header( hdrbuf, hdrbufsize, itypesize, &
	341	FileName, SysDepInfo, io_form, DataHandle )
	342	!<DESCRIPTION>
	343	!<PRE>
	344	! Items and their starting locations within a "open for write begin" data
	345	! header. Assume that the data header is stored in integer vector "hdrbuf":
	346	! hdrbuf(1) = hdrbufsize
	347	! hdrbuf(2) = headerTag
	348	! hdrbuf(3) = DataHandle
	349	! hdrbuf(4) = io_form
	350	! hdrbuf(5) = LEN(TRIM(FileName))
	351	! hdrbuf(6:5+n1) = FileName ! n1 = LEN(TRIM(FileName)) + 1
	352	! hdrbuf(6+n1) = LEN(TRIM(SysDepInfo))
	353	! hdrbuf(7+n1:6+n1+n2) = SysDepInfo ! n2 = LEN(TRIM(SysDepInfo)) + 1
	354	!
	355	! Further details for some items:
	356	! hdrbufsize: Size of this data header in bytes.
	357	! headerTag: "Header tag" that tells the I/O quilt servers what kind of
	358	! header this is. For an "open for write begin" header it must be set to
	359	! int_open_for_write_begin. See file intio_tags.h for a complete list of
	360	! these tags.
	361	! DataHandle: Descriptor for an open data set.
	362	! io_form: I/O format for this file (netCDF, etc.).
	363	! FileName: File name.
	364	! SysDepInfo: System dependent information used for optional additional
	365	! I/O control information.
	366	! Other items are described in detail in the "WRF I/O and Model Coupling API
	367	! Specification".
	368	!
	369	!</PRE>
	370	!</DESCRIPTION>
	371	IMPLICIT NONE
	372	#include "intio_tags.h"
	373	INTEGER, INTENT(INOUT) :: hdrbuf(*)
	374	INTEGER, INTENT(OUT) :: hdrbufsize
	375	INTEGER, INTENT(INOUT) :: itypesize
	376	INTEGER , INTENT(IN) :: io_form
	377	INTEGER , INTENT(IN) :: DataHandle
	378	CHARACTER(), INTENT(INOUT) :: FileName
	379	CHARACTER(), INTENT(INOUT) :: SysDepInfo
	380	!Local
	381	INTEGER i, n, j
	382	!
	383	hdrbuf(1) = 0 !deferred
	384	hdrbuf(2) = int_open_for_write_begin
	385	i = 3
	386	hdrbuf(i) = DataHandle ; i = i+1
	387	hdrbuf(i) = io_form ; i = i+1
	388	!j = i
	389	call int_pack_string( FileName, hdrbuf(i), n ) ; i = i + n
	390	!write(0,*)'int_gen_ofwb_header FileName ',TRIM(FileName),hdrbuf(j),n
	391	!j = i
	392	call int_pack_string( SysDepInfo, hdrbuf(i), n ) ; i = i + n
	393	!write(0,*)'int_gen_ofwb_header SysDepInfo ',TRIM(SysDepInfo),hdrbuf(j),n
	394	hdrbufsize = (i-1) * itypesize ! return the number in bytes
	395	hdrbuf(1) = hdrbufsize
	396	!write(0,*)'int_gen_ofwb_header hdrbuf(1) ',hdrbuf(1)
	397	RETURN
	398	END SUBROUTINE int_gen_ofwb_header
	399
	400	!get open for write begin header
	401	SUBROUTINE int_get_ofwb_header( hdrbuf, hdrbufsize, itypesize, &
	402	FileName, SysDepInfo, io_form, DataHandle )
	403	!<DESCRIPTION>
	404	!<PRE>
	405	! See documentation block in int_gen_ofwb_header() for
	406	! a description of a "open for write begin" header.
	407	!</PRE>
	408	!</DESCRIPTION>
	409	IMPLICIT NONE
	410	#include "intio_tags.h"
	411	INTEGER, INTENT(INOUT) :: hdrbuf(*)
	412	INTEGER, INTENT(OUT) :: hdrbufsize
	413	INTEGER, INTENT(INOUT) :: itypesize
	414	INTEGER , INTENT(OUT) :: DataHandle
	415	INTEGER , INTENT(OUT) :: io_form
	416	CHARACTER(), INTENT (INOUT) :: FileName
	417	CHARACTER(), INTENT (INOUT) :: SysDepInfo
	418	!Local
	419	INTEGER i, n, j
	420	!
	421	hdrbufsize = hdrbuf(1)
	422	!write(0,*)' int_get_ofwb_header next rec start ',hdrbuf(hdrbufsize+1)
	423	! IF ( hdrbuf(2) .NE. int_open_for_write_begin ) THEN
	424	! CALL wrf_error_fatal ( "int_get_ofwb_header: hdrbuf ne int_open_for_write_begin")
	425	! ENDIF
	426	i = 3
	427	DataHandle = hdrbuf(i) ; i = i+1
	428	!write(0,*)' int_get_ofwb_header next rec',i, hdrbuf(hdrbufsize+1)
	429	io_form = hdrbuf(i) ; i = i+1
	430	!write(0,*)' int_get_ofwb_header next rec',i, hdrbuf(hdrbufsize+1)
	431
	432	!j = i
	433	call int_unpack_string( FileName, hdrbuf(i), n ) ; i = i+n
	434	!write(0,*)'int_get_ofwb_header FileName ',TRIM(FileName),hdrbuf(j),n
	435	!write(0,*)' int_get_ofwb_header next rec',i, hdrbuf(hdrbufsize+1)
	436	!j = i
	437	call int_unpack_string( SysDepInfo, hdrbuf(i), n ) ; i = i+n
	438	!write(0,*)'int_get_ofwb_header SysDepInfo ',TRIM(SysDepInfo),hdrbuf(j),n
	439	!write(0,*)' int_get_ofwb_header next rec',i, hdrbuf(hdrbufsize+1)
	440	!write(0,*)'int_get_ofwb_header hdrbufsize ',hdrbufsize
	441	RETURN
	442	END SUBROUTINE int_get_ofwb_header
	443
	444	!!!!!!!!!!
	445
	446	SUBROUTINE int_gen_handle_header( hdrbuf, hdrbufsize, itypesize, &
	447	DataHandle , code )
	448	!<DESCRIPTION>
	449	!<PRE>
	450	! Items and their starting locations within a "generic handle" data header.
	451	! Several types of data headers contain only a DataHandle and a header tag
	452	! (I/O command). This routine is used for all of them. Assume that
	453	! the data header is stored in integer vector "hdrbuf":
	454	! hdrbuf(1) = hdrbufsize
	455	! hdrbuf(2) = headerTag
	456	! hdrbuf(3) = DataHandle
	457	!
	458	! Further details for some items:
	459	! hdrbufsize: Size of this data header in bytes.
	460	! headerTag: "Header tag" that tells the I/O quilt servers what kind of
	461	! header this is. For a "generic handle" header there are
	462	! several possible values. In this routine, dummy argument
	463	! "code" is used as headerTag.
	464	! DataHandle: Descriptor for an open data set.
	465	!
	466	!</PRE>
	467	!</DESCRIPTION>
	468	IMPLICIT NONE
	469	#include "intio_tags.h"
	470	INTEGER, INTENT(INOUT) :: hdrbuf(*)
	471	INTEGER, INTENT(OUT) :: hdrbufsize
	472	INTEGER, INTENT(INOUT) :: itypesize
	473	INTEGER ,INTENT(IN) :: DataHandle, code
	474	!Local
	475	INTEGER i
	476	!
	477	hdrbuf(1) = 0 !deferred
	478	hdrbuf(2) = code
	479	i = 3
	480	hdrbuf(i) = DataHandle ; i = i+1
	481	hdrbufsize = (i-1) * itypesize ! return the number in bytes
	482	hdrbuf(1) = hdrbufsize
	483	RETURN
	484	END SUBROUTINE int_gen_handle_header
	485
	486	SUBROUTINE int_get_handle_header( hdrbuf, hdrbufsize, itypesize, &
	487	DataHandle , code )
	488	!<DESCRIPTION>
	489	!<PRE>
	490	! See documentation block in int_gen_handle_header() for
	491	! a description of a "generic handle" header.
	492	!</PRE>
	493	!</DESCRIPTION>
	494	IMPLICIT NONE
	495	#include "intio_tags.h"
	496	INTEGER, INTENT(INOUT) :: hdrbuf(*)
	497	INTEGER, INTENT(OUT) :: hdrbufsize
	498	INTEGER, INTENT(INOUT) :: itypesize
	499	INTEGER ,INTENT(OUT) :: DataHandle, code
	500	!Local
	501	INTEGER i
	502	!
	503	hdrbufsize = hdrbuf(1)
	504	code = hdrbuf(2)
	505	i = 3
	506	DataHandle = hdrbuf(i) ; i = i+1
	507	RETURN
	508	END SUBROUTINE int_get_handle_header
	509
	510	!!!!!!!!!!!!
	511
	512	SUBROUTINE int_gen_ti_header_integer( hdrbuf, hdrbufsize, itypesize, typesize, &
	513	DataHandle, Element, Data, Count, code )
	514	!<DESCRIPTION>
	515	!<PRE>
	516	! Items and their starting locations within a "time-independent integer"
	517	! data header. Assume that the data header is stored in integer vector
	518	! "hdrbuf":
	519	! hdrbuf(1) = hdrbufsize
	520	! hdrbuf(2) = headerTag
	521	! hdrbuf(3) = DataHandle
	522	! hdrbuf(4) = typesize
	523	! hdrbuf(5) = Count
	524	! hdrbuf(6:6+n1) = Data ! n1 = (Count * typesize / itypesize) + 1
	525	! hdrbuf(7+n1) = LEN(TRIM(Element))
	526	! hdrbuf(8+n1:7+n1+n2) = Element ! n2 = LEN(TRIM(Element)) + 1
	527	!
	528	! Further details for some items:
	529	! hdrbufsize: Size of this data header in bytes.
	530	! headerTag: "Header tag" that tells the I/O quilt servers what kind of
	531	! header this is. For an "time-independent integer" header it must be
	532	! set to int_dom_ti_integer. See file intio_tags.h for a complete
	533	! list of these tags.
	534	! DataHandle: Descriptor for an open data set.
	535	! typesize: Size in bytes of each element of Data.
	536	! Count: Number of elements in Data.
	537	! Data: Data to write to file.
	538	! Element: Name of the data.
	539	! Other items are described in detail in the "WRF I/O and Model Coupling API
	540	! Specification".
	541	!
	542	!</PRE>
	543	!</DESCRIPTION>
	544	IMPLICIT NONE
	545	#include "intio_tags.h"
	546	INTEGER, INTENT(INOUT) :: hdrbuf(*)
	547	INTEGER, INTENT(OUT) :: hdrbufsize
	548	INTEGER, INTENT(IN) :: itypesize, typesize
	549	CHARACTER(), INTENT(INOUT) :: Element
	550	INTEGER, INTENT(IN) :: Data(*)
	551	INTEGER, INTENT(IN) :: DataHandle, Count, code
	552	!Local
	553	INTEGER i, n
	554	!
	555	CALL int_gen_ti_header_c ( hdrbuf, hdrbufsize, itypesize, typesize, &
	556	DataHandle, Data, Count, code )
	557	i = hdrbufsize/itypesize + 1 ;
	558	!write(0,*)'int_gen_ti_header_integer ',TRIM(Element)
	559	CALL int_pack_string ( Element, hdrbuf( i ), n ) ; i = i + n
	560	hdrbufsize = n * itypesize + hdrbufsize ! return the number in bytes
	561	hdrbuf(1) = hdrbufsize
	562	RETURN
	563	END SUBROUTINE int_gen_ti_header_integer
	564
	565	SUBROUTINE int_gen_ti_header_real( hdrbuf, hdrbufsize, itypesize, typesize, &
	566	DataHandle, Element, Data, Count, code )
	567	!<DESCRIPTION>
	568	!<PRE>
	569	! Same as int_gen_ti_header_integer except that Data has type REAL.
	570	!</PRE>
	571	!</DESCRIPTION>
	572	IMPLICIT NONE
	573	#include "intio_tags.h"
	574	INTEGER, INTENT(INOUT) :: hdrbuf(*)
	575	INTEGER, INTENT(OUT) :: hdrbufsize
	576	INTEGER, INTENT(IN) :: itypesize, typesize
	577	CHARACTER(), INTENT(INOUT) :: Element
	578	REAL, INTENT(IN) :: Data(*)
	579	INTEGER, INTENT(IN) :: DataHandle, Count, code
	580	!Local
	581	INTEGER i, n
	582	!
	583	CALL int_gen_ti_header_c ( hdrbuf, hdrbufsize, itypesize, typesize, &
	584	DataHandle, Data, Count, code )
	585	i = hdrbufsize/itypesize + 1 ;
	586	!write(0,*)'int_gen_ti_header_real ',TRIM(Element)
	587	CALL int_pack_string ( Element, hdrbuf( i ), n ) ; i = i + n
	588	hdrbufsize = n * itypesize + hdrbufsize ! return the number in bytes
	589	hdrbuf(1) = hdrbufsize
	590	RETURN
	591	END SUBROUTINE int_gen_ti_header_real
	592
	593	SUBROUTINE int_get_ti_header_integer( hdrbuf, hdrbufsize, itypesize, typesize, &
	594	DataHandle, Element, Data, Count, code )
	595	!<DESCRIPTION>
	596	!<PRE>
	597	! Same as int_gen_ti_header_integer except that Data is read from
	598	! the file.
	599	!</PRE>
	600	!</DESCRIPTION>
	601	IMPLICIT NONE
	602	#include "intio_tags.h"
	603	INTEGER, INTENT(INOUT) :: hdrbuf(*)
	604	INTEGER, INTENT(OUT) :: hdrbufsize
	605	INTEGER, INTENT(IN) :: itypesize, typesize
	606	CHARACTER(), INTENT(INOUT) :: Element
	607	INTEGER, INTENT(OUT) :: Data(*)
	608	INTEGER, INTENT(OUT) :: DataHandle, Count, code
	609	!Local
	610	INTEGER i, n
	611	!
	612
	613	CALL int_get_ti_header_c ( hdrbuf, hdrbufsize, n, itypesize, typesize, &
	614	DataHandle, Data, Count, code )
	615	i = 1
	616	CALL int_unpack_string ( Element, hdrbuf( n/itypesize + 1 ), n ) ;
	617	!write(0,*)'int_get_ti_header_integer ',TRIM(Element), Data(1)
	618	hdrbufsize = hdrbuf(1)
	619	RETURN
	620	END SUBROUTINE int_get_ti_header_integer
	621
	622	SUBROUTINE int_get_ti_header_real( hdrbuf, hdrbufsize, itypesize, typesize, &
	623	DataHandle, Element, Data, Count, code )
	624	!<DESCRIPTION>
	625	!<PRE>
	626	! Same as int_gen_ti_header_real except that Data is read from
	627	! the file.
	628	!</PRE>
	629	!</DESCRIPTION>
	630	IMPLICIT NONE
	631	#include "intio_tags.h"
	632	INTEGER, INTENT(INOUT) :: hdrbuf(*)
	633	INTEGER, INTENT(OUT) :: hdrbufsize
	634	INTEGER, INTENT(IN) :: itypesize, typesize
	635	CHARACTER(), INTENT(INOUT) :: Element
	636	REAL, INTENT(OUT) :: Data(*)
	637	INTEGER, INTENT(OUT) :: DataHandle, Count, code
	638	!Local
	639	INTEGER i, n
	640	!
	641
	642	CALL int_get_ti_header_c ( hdrbuf, hdrbufsize, n, itypesize, typesize, &
	643	DataHandle, Data, Count, code )
	644	i = 1
	645	CALL int_unpack_string ( Element, hdrbuf( n/itypesize + 1 ), n ) ;
	646	!write(0,*)'int_get_ti_header_real ',TRIM(Element), Data(1)
	647	hdrbufsize = hdrbuf(1)
	648	RETURN
	649	END SUBROUTINE int_get_ti_header_real
	650
	651	!!!!!!!!!!!!
	652
	653	SUBROUTINE int_gen_ti_header_char( hdrbuf, hdrbufsize, itypesize, &
	654	DataHandle, Element, VarName, Data, code )
	655	!<DESCRIPTION>
	656	!<PRE>
	657	! Items and their starting locations within a "time-independent string"
	658	! data header. Assume that the data header is stored in integer vector
	659	! "hdrbuf":
	660	! hdrbuf(1) = hdrbufsize
	661	! hdrbuf(2) = headerTag
	662	! hdrbuf(3) = DataHandle
	663	! hdrbuf(4) = typesize
	664	! hdrbuf(5) = LEN(TRIM(Element))
	665	! hdrbuf(6:5+n1) = Element ! n1 = LEN(TRIM(Element)) + 1
	666	! hdrbuf(6+n1) = LEN(TRIM(Data))
	667	! hdrbuf(7+n1:6+n1+n2) = Data ! n2 = LEN(TRIM(Data)) + 1
	668	! hdrbuf(7+n1+n2) = LEN(TRIM(VarName))
	669	! hdrbuf(8+n1+n2:7+n1+n2+n3) = VarName ! n3 = LEN(TRIM(VarName)) + 1
	670	!
	671	! Further details for some items:
	672	! hdrbufsize: Size of this data header in bytes.
	673	! headerTag: "Header tag" that tells the I/O quilt servers what kind of
	674	! header this is. For an "time-independent string" header it must be
	675	! set to int_dom_ti_char. See file intio_tags.h for a complete
	676	! list of these tags.
	677	! DataHandle: Descriptor for an open data set.
	678	! typesize: 1 (size in bytes of a single CHARACTER).
	679	! Element: Name of the data.
	680	! Data: Data to write to file.
	681	! VarName: Variable name. Used for *_<get\|put>_var_ti_char but not for
	682	! *_<get\|put>_dom_ti_char.
	683	! Other items are described in detail in the "WRF I/O and Model Coupling API
	684	! Specification".
	685	!
	686	!</PRE>
	687	!</DESCRIPTION>
	688	IMPLICIT NONE
	689	#include "intio_tags.h"
	690	INTEGER, INTENT(INOUT) :: hdrbuf(*)
	691	INTEGER, INTENT(OUT) :: hdrbufsize
	692	INTEGER, INTENT(IN) :: itypesize
	693	CHARACTER(), INTENT(IN) :: Element, Data, VarName
	694	INTEGER, INTENT(IN) :: DataHandle, code
	695	!Local
	696	INTEGER :: DummyData
	697	INTEGER i, n, Count, DummyCount
	698	!
	699	DummyCount = 0
	700	CALL int_gen_ti_header_c ( hdrbuf, hdrbufsize, itypesize, 1, &
	701	DataHandle, DummyData, DummyCount, code )
	702	i = hdrbufsize/itypesize+1 ;
	703	CALL int_pack_string ( Element, hdrbuf( i ), n ) ; i = i + n
	704	CALL int_pack_string ( Data , hdrbuf( i ), n ) ; i = i + n
	705	CALL int_pack_string ( VarName , hdrbuf( i ), n ) ; i = i + n
	706	hdrbufsize = (i-1) * itypesize + hdrbufsize ! return the number in bytes
	707	hdrbuf(1) = hdrbufsize
	708	RETURN
	709	END SUBROUTINE int_gen_ti_header_char
	710
	711	SUBROUTINE int_get_ti_header_char( hdrbuf, hdrbufsize, itypesize, &
	712	DataHandle, Element, VarName, Data, code )
	713	!<DESCRIPTION>
	714	!<PRE>
	715	! Same as int_gen_ti_header_char except that Data is read from
	716	! the file.
	717	!</PRE>
	718	!</DESCRIPTION>
	719	IMPLICIT NONE
	720	#include "intio_tags.h"
	721	INTEGER, INTENT(INOUT) :: hdrbuf(*)
	722	INTEGER, INTENT(OUT) :: hdrbufsize
	723	INTEGER, INTENT(IN) :: itypesize
	724	CHARACTER(), INTENT(INOUT) :: Element, Data, VarName
	725	INTEGER, INTENT(OUT) :: DataHandle, code
	726	!Local
	727	INTEGER i, n, DummyCount, typesize
	728	CHARACTER * 132 dummyData
	729	!
	730	CALL int_get_ti_header_c ( hdrbuf, hdrbufsize, n, itypesize, typesize, &
	731	DataHandle, dummyData, DummyCount, code )
	732	i = n/itypesize+1 ;
	733	CALL int_unpack_string ( Element, hdrbuf( i ), n ) ; i = i + n
	734	CALL int_unpack_string ( Data , hdrbuf( i ), n ) ; i = i + n
	735	CALL int_unpack_string ( VarName , hdrbuf( i ), n ) ; i = i + n
	736	hdrbufsize = hdrbuf(1)
	737
	738	RETURN
	739	END SUBROUTINE int_get_ti_header_char
	740
	741
	742	!!!!!!!!!!!!
	743
	744	SUBROUTINE int_gen_td_header_char( hdrbuf, hdrbufsize, itypesize, &
	745	DataHandle, DateStr, Element, Data, code )
	746	!<DESCRIPTION>
	747	!<PRE>
	748	! Items and their starting locations within a "time-dependent string"
	749	! data header. Assume that the data header is stored in integer vector
	750	! "hdrbuf":
	751	! hdrbuf(1) = hdrbufsize
	752	! hdrbuf(2) = headerTag
	753	! hdrbuf(3) = DataHandle
	754	! hdrbuf(4) = typesize
	755	! hdrbuf(5) = LEN(TRIM(Element))
	756	! hdrbuf(6:5+n1) = Element ! n1 = LEN(TRIM(Element)) + 1
	757	! hdrbuf(6+n1) = LEN(TRIM(DateStr))
	758	! hdrbuf(7+n1:6+n1+n2) = DateStr ! n2 = LEN(TRIM(DateStr)) + 1
	759	! hdrbuf(7+n1+n2) = LEN(TRIM(Data))
	760	! hdrbuf(8+n1+n2:7+n1+n2+n3) = Data ! n3 = LEN(TRIM(Data)) + 1
	761	!
	762	! Further details for some items:
	763	! hdrbufsize: Size of this data header in bytes.
	764	! headerTag: "Header tag" that tells the I/O quilt servers what kind of
	765	! header this is. For an "time-dependent string" header it must be
	766	! set to int_dom_td_char. See file intio_tags.h for a complete
	767	! list of these tags.
	768	! DataHandle: Descriptor for an open data set.
	769	! typesize: 1 (size in bytes of a single CHARACTER).
	770	! Element: Name of the data.
	771	! Data: Data to write to file.
	772	! Other items are described in detail in the "WRF I/O and Model Coupling API
	773	! Specification".
	774	!
	775	!</PRE>
	776	!</DESCRIPTION>
	777	IMPLICIT NONE
	778	#include "intio_tags.h"
	779	INTEGER, INTENT(INOUT) :: hdrbuf(*)
	780	INTEGER, INTENT(OUT) :: hdrbufsize
	781	INTEGER, INTENT(IN) :: itypesize
	782	CHARACTER(), INTENT(INOUT) :: DateStr, Element, Data
	783	INTEGER, INTENT(IN) :: DataHandle, code
	784	!Local
	785	INTEGER i, n, DummyCount, DummyData
	786	!
	787	DummyCount = 0
	788
	789	CALL int_gen_ti_header_c ( hdrbuf, hdrbufsize, itypesize, 1, &
	790	DataHandle, DummyData, DummyCount, code )
	791	i = hdrbufsize/itypesize + 1 ;
	792	CALL int_pack_string ( Element, hdrbuf( i ), n ) ; i = i + n
	793	CALL int_pack_string ( DateStr, hdrbuf( i ), n ) ; i = i + n
	794	CALL int_pack_string ( Data , hdrbuf( i ), n ) ; i = i + n
	795	hdrbufsize = (i-1) * itypesize + hdrbufsize ! return the number in bytes
	796	hdrbuf(1) = hdrbufsize
	797	RETURN
	798	END SUBROUTINE int_gen_td_header_char
	799
	800	SUBROUTINE int_get_td_header_char( hdrbuf, hdrbufsize, itypesize, &
	801	DataHandle, DateStr, Element, Data, code )
	802	!<DESCRIPTION>
	803	!<PRE>
	804	! Same as int_gen_td_header_char except that Data is read from
	805	! the file.
	806	!</PRE>
	807	!</DESCRIPTION>
	808	IMPLICIT NONE
	809	#include "intio_tags.h"
	810	INTEGER, INTENT(INOUT) :: hdrbuf(*)
	811	INTEGER, INTENT(OUT) :: hdrbufsize
	812	INTEGER, INTENT(IN) :: itypesize
	813	CHARACTER(), INTENT(INOUT) :: DateStr, Element, Data
	814	INTEGER, INTENT(OUT) :: DataHandle, code
	815	!Local
	816	INTEGER i, n, Count, typesize
	817	!
	818
	819	CALL int_get_ti_header_c ( hdrbuf, hdrbufsize, n, itypesize, typesize, &
	820	DataHandle, Data, Count, code )
	821	i = n/itypesize + 1 ;
	822	CALL int_unpack_string ( Element, hdrbuf( i ), n ) ; i = i + n ;
	823	CALL int_unpack_string ( DateStr, hdrbuf( i ), n ) ; i = i + n ;
	824	CALL int_unpack_string ( Data , hdrbuf( i ), n ) ; i = i + n ;
	825	hdrbufsize = hdrbuf(1)
	826	RETURN
	827	END SUBROUTINE int_get_td_header_char
	828
	829	SUBROUTINE int_gen_td_header_integer( hdrbuf, hdrbufsize, itypesize, typesize, &
	830	DataHandle, DateStr, Element, Data, Count, code )
	831	!<DESCRIPTION>
	832	!<PRE>
	833	! Items and their starting locations within a "time-dependent integer"
	834	! data header. Assume that the data header is stored in integer vector
	835	! "hdrbuf":
	836	! hdrbuf(1) = hdrbufsize
	837	! hdrbuf(2) = headerTag
	838	! hdrbuf(3) = DataHandle
	839	! hdrbuf(4) = typesize
	840	! hdrbuf(5) = Count
	841	! hdrbuf(6:6+n1) = Data ! n1 = (Count * typesize / itypesize) + 1
	842	! hdrbuf(7+n1) = LEN(TRIM(DateStr))
	843	! hdrbuf(8+n1:7+n1+n2) = DateStr ! n2 = LEN(TRIM(DateStr)) + 1
	844	! hdrbuf(8+n1+n2) = LEN(TRIM(Element))
	845	! hdrbuf(9+n1+n2:8+n1+n2+n3) = Element ! n3 = LEN(TRIM(Element)) + 1
	846	!
	847	! Further details for some items:
	848	! hdrbufsize: Size of this data header in bytes.
	849	! headerTag: "Header tag" that tells the I/O quilt servers what kind of
	850	! header this is. For an "time-dependent integer" header it must be
	851	! set to int_dom_td_integer. See file intio_tags.h for a complete
	852	! list of these tags.
	853	! DataHandle: Descriptor for an open data set.
	854	! typesize: 1 (size in bytes of a single CHARACTER).
	855	! Element: Name of the data.
	856	! Count: Number of elements in Data.
	857	! Data: Data to write to file.
	858	! Other items are described in detail in the "WRF I/O and Model Coupling API
	859	! Specification".
	860	!
	861	!</PRE>
	862	!</DESCRIPTION>
	863	IMPLICIT NONE
	864	#include "intio_tags.h"
	865	INTEGER, INTENT(INOUT) :: hdrbuf(*)
	866	INTEGER, INTENT(OUT) :: hdrbufsize
	867	INTEGER, INTENT(IN) :: itypesize, typesize
	868	CHARACTER(), INTENT(INOUT) :: DateStr, Element
	869	INTEGER, INTENT(IN) :: Data(*)
	870	INTEGER, INTENT(IN) :: DataHandle, Count, code
	871	!Local
	872	INTEGER i, n
	873	!
	874
	875	CALL int_gen_ti_header_c ( hdrbuf, hdrbufsize, itypesize, typesize, &
	876	DataHandle, Data, Count, code )
	877	i = hdrbufsize/itypesize + 1 ;
	878	CALL int_pack_string ( DateStr, hdrbuf( i ), n ) ; i = i + n
	879	CALL int_pack_string ( Element, hdrbuf( i ), n ) ; i = i + n
	880	hdrbufsize = (i-1) * itypesize + hdrbufsize ! return the number in bytes
	881	hdrbuf(1) = hdrbufsize
	882	RETURN
	883	END SUBROUTINE int_gen_td_header_integer
	884
	885	SUBROUTINE int_gen_td_header_real( hdrbuf, hdrbufsize, itypesize, typesize, &
	886	DataHandle, DateStr, Element, Data, Count, code )
	887	!<DESCRIPTION>
	888	!<PRE>
	889	! Same as int_gen_td_header_integer except that Data has type REAL.
	890	!</PRE>
	891	!</DESCRIPTION>
	892	IMPLICIT NONE
	893	#include "intio_tags.h"
	894	INTEGER, INTENT(INOUT) :: hdrbuf(*)
	895	INTEGER, INTENT(OUT) :: hdrbufsize
	896	INTEGER, INTENT(IN) :: itypesize, typesize
	897	CHARACTER(), INTENT(INOUT) :: DateStr, Element
	898	REAL, INTENT(IN) :: Data(*)
	899	INTEGER, INTENT(IN) :: DataHandle, Count, code
	900	!Local
	901	INTEGER i, n
	902	!
	903
	904	CALL int_gen_ti_header_c ( hdrbuf, hdrbufsize, itypesize, typesize, &
	905	DataHandle, Data, Count, code )
	906	i = hdrbufsize/itypesize + 1 ;
	907	CALL int_pack_string ( DateStr, hdrbuf( i ), n ) ; i = i + n
	908	CALL int_pack_string ( Element, hdrbuf( i ), n ) ; i = i + n
	909	hdrbufsize = (i-1) * itypesize + hdrbufsize ! return the number in bytes
	910	hdrbuf(1) = hdrbufsize
	911	RETURN
	912	END SUBROUTINE int_gen_td_header_real
	913
	914	SUBROUTINE int_get_td_header_integer( hdrbuf, hdrbufsize, itypesize, typesize, &
	915	DataHandle, DateStr, Element, Data, Count, code )
	916	!<DESCRIPTION>
	917	!<PRE>
	918	! Same as int_gen_td_header_integer except that Data is read from
	919	! the file.
	920	!</PRE>
	921	!</DESCRIPTION>
	922	IMPLICIT NONE
	923	#include "intio_tags.h"
	924	INTEGER, INTENT(INOUT) :: hdrbuf(*)
	925	INTEGER, INTENT(OUT) :: hdrbufsize
	926	INTEGER, INTENT(IN) :: itypesize, typesize
	927	CHARACTER(), INTENT(INOUT) :: DateStr, Element
	928	INTEGER, INTENT(OUT) :: Data(*)
	929	INTEGER, INTENT(OUT) :: DataHandle, Count, code
	930	!Local
	931	INTEGER i, n
	932	!
	933
	934	CALL int_get_ti_header_c ( hdrbuf, hdrbufsize, n, itypesize, typesize, &
	935	DataHandle, Data, Count, code )
	936	i = n/itypesize + 1 ;
	937	CALL int_unpack_string ( DateStr, hdrbuf( i ), n ) ; i = i + n ;
	938	CALL int_unpack_string ( Element, hdrbuf( i ), n ) ; i = i + n ;
	939	hdrbufsize = hdrbuf(1)
	940	RETURN
	941	END SUBROUTINE int_get_td_header_integer
	942
	943	SUBROUTINE int_get_td_header_real( hdrbuf, hdrbufsize, itypesize, typesize, &
	944	DataHandle, DateStr, Element, Data, Count, code )
	945	!<DESCRIPTION>
	946	!<PRE>
	947	! Same as int_gen_td_header_real except that Data is read from
	948	! the file.
	949	!</PRE>
	950	!</DESCRIPTION>
	951	IMPLICIT NONE
	952	#include "intio_tags.h"
	953	INTEGER, INTENT(INOUT) :: hdrbuf(*)
	954	INTEGER, INTENT(OUT) :: hdrbufsize
	955	INTEGER, INTENT(IN) :: itypesize, typesize
	956	CHARACTER(), INTENT(INOUT) :: DateStr, Element
	957	REAL , INTENT(OUT) :: Data(*)
	958	INTEGER, INTENT(OUT) :: DataHandle, Count, code
	959	!Local
	960	INTEGER i, n
	961	!
	962
	963	CALL int_get_ti_header_c ( hdrbuf, hdrbufsize, n, itypesize, typesize, &
	964	DataHandle, Data, Count, code )
	965	i = n/itypesize + 1 ;
	966	CALL int_unpack_string ( DateStr, hdrbuf( i ), n ) ; i = i + n ;
	967	CALL int_unpack_string ( Element, hdrbuf( i ), n ) ; i = i + n ;
	968	hdrbufsize = hdrbuf(1)
	969	RETURN
	970	END SUBROUTINE int_get_td_header_real
	971
	972	!!!!!!!!!!!!!!
	973
	974	SUBROUTINE int_gen_noop_header ( hdrbuf, hdrbufsize, itypesize )
	975	IMPLICIT NONE
	976	!<DESCRIPTION>
	977	!<PRE>
	978	! Items and their starting locations within a "no-operation"
	979	! data header. Assume that the data header is stored in integer vector
	980	! "hdrbuf":
	981	! hdrbuf(1) = hdrbufsize
	982	! hdrbuf(2) = headerTag
	983	!
	984	! Further details for some items:
	985	! hdrbufsize: Size of this data header in bytes.
	986	! headerTag: "Header tag" that tells the I/O quilt servers what kind of
	987	! header this is. For an "no-operation" header it must be
	988	! set to int_noop. See file intio_tags.h for a complete
	989	! list of these tags.
	990	!
	991	!</PRE>
	992	!</DESCRIPTION>
	993	#include "intio_tags.h"
	994	INTEGER, INTENT(INOUT) :: hdrbuf(*)
	995	INTEGER, INTENT(OUT) :: hdrbufsize
	996	INTEGER, INTENT(INOUT) :: itypesize
	997	!Local
	998	INTEGER i
	999	!
	1000	hdrbuf(1) = 0 !deferred
	1001	hdrbuf(2) = int_noop
	1002	i = 3
	1003	hdrbufsize = (i-1) * itypesize ! return the number in bytes
	1004	hdrbuf(1) = hdrbufsize
	1005	RETURN
	1006	END SUBROUTINE int_gen_noop_header
	1007
	1008	SUBROUTINE int_get_noop_header( hdrbuf, hdrbufsize, itypesize )
	1009	!<DESCRIPTION>
	1010	!<PRE>
	1011	! See documentation block in int_gen_noop_header() for
	1012	! a description of a "no-operation" header.
	1013	!</PRE>
	1014	!</DESCRIPTION>
	1015	IMPLICIT NONE
	1016	#include "intio_tags.h"
	1017	INTEGER, INTENT(INOUT) :: hdrbuf(*)
	1018	INTEGER, INTENT(OUT) :: hdrbufsize
	1019	INTEGER, INTENT(INOUT) :: itypesize
	1020	!Local
	1021	INTEGER i
	1022	!
	1023	hdrbufsize = hdrbuf(1)
	1024	IF ( hdrbuf(2) .NE. int_noop ) THEN
	1025	CALL wrf_error_fatal ( "int_get_noop_header: hdrbuf ne int_noop")
	1026	ENDIF
	1027	i = 3
	1028	RETURN
	1029	END SUBROUTINE int_get_noop_header
	1030
	1031
	1032	! first int is length of string to follow then string encodes as ints
	1033	SUBROUTINE int_pack_string ( str, buf, n )
	1034	IMPLICIT NONE
	1035	!<DESCRIPTION>
	1036	!<PRE>
	1037	! This routine is used to store a string as a sequence of integers.
	1038	! The first integer is the string length.
	1039	!</PRE>
	1040	!</DESCRIPTION>
	1041	CHARACTER(), INTENT(IN) :: str
	1042	INTEGER, INTENT(OUT) :: n ! on return, N is the number of ints stored in buf
	1043	INTEGER, INTENT(OUT), DIMENSION(*) :: buf
	1044	!Local
	1045	INTEGER i
	1046	!
	1047	n = 1
	1048	buf(n) = LEN(TRIM(str))
	1049	n = n+1
	1050	DO i = 1, LEN(TRIM(str))
	1051	buf(n) = ichar(str(i:i))
	1052	n = n+1
	1053	ENDDO
	1054	n = n - 1
	1055	END SUBROUTINE int_pack_string
	1056
	1057	SUBROUTINE int_unpack_string ( str, buf, n )
	1058	IMPLICIT NONE
	1059	!<DESCRIPTION>
	1060	!<PRE>
	1061	! This routine is used to extract a string from a sequence of integers.
	1062	! The first integer is the string length.
	1063	!</PRE>
	1064	!</DESCRIPTION>
	1065	CHARACTER(), INTENT(OUT) :: str
	1066	INTEGER, INTENT(OUT) :: n ! on return, N is the number of ints copied from buf
	1067	INTEGER, INTENT(IN), DIMENSION(*) :: buf
	1068	!Local
	1069	INTEGER i
	1070	INTEGER strlen
	1071
	1072	strlen = buf(1)
	1073	str = ""
	1074	DO i = 1, strlen
	1075	str(i:i) = char(buf(i+1))
	1076	ENDDO
	1077	n = strlen + 1
	1078	END SUBROUTINE int_unpack_string
	1079
	1080	END MODULE module_internal_header_util
	1081

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

Download in other formats:

Original Format