MODULE module_internal_header_util ! !
! Subroutines defined in this module are used to generate (put together) and get (take apart) 
! data headers stored in the form of integer vectors.
! 
! Data headers serve two purposes:  
!   - Provide a package-independent metadata storage and retrieval mechanism 
!     for I/O packages that do not support native metadata.  
!   - Provide a mechanism for communicating I/O commands from compute 
!     tasks to quilt tasks when I/O quilt servers are enabled.  
! 
! Within a data header, character strings are stored one character per integer.  
! The number of characters is stored immediately before the first character of 
! each string.
!
! In an I/O package that does not support native metadata, routines 
! int_gen_*_header() are called to pack information into data headers that 
! are then written to files.  Routines int_get_*_header() are called to 
! extract information from a data headers after they have been read from a 
! file.  
!
! When I/O quilt server tasks are used, routines int_gen_*_header() 
! are called by compute tasks to pack information into data headers 
! (commands) that are then sent to the I/O quilt servers.  Routines 
! int_get_*_header() are called by I/O quilt servers to extract 
! information from data headers (commands) received from the compute 
! tasks.  
!
!
!
INTERFACE int_get_ti_header MODULE PROCEDURE int_get_ti_header_integer, int_get_ti_header_real END INTERFACE INTERFACE int_gen_ti_header MODULE PROCEDURE int_gen_ti_header_integer, int_gen_ti_header_real END INTERFACE INTERFACE int_get_td_header MODULE PROCEDURE int_get_td_header_integer, int_get_td_header_real END INTERFACE INTERFACE int_gen_td_header MODULE PROCEDURE int_gen_td_header_integer, int_gen_td_header_real END INTERFACE PRIVATE :: int_pack_string, int_unpack_string CONTAINS !!!!!!!!!!!!! header manipulation routines !!!!!!!!!!!!!!! INTEGER FUNCTION get_hdr_tag( hdrbuf ) IMPLICIT NONE INTEGER, INTENT(IN) :: hdrbuf(*) get_hdr_tag = hdrbuf(2) RETURN END FUNCTION get_hdr_tag INTEGER FUNCTION get_hdr_rec_size( hdrbuf ) IMPLICIT NONE INTEGER, INTENT(IN) :: hdrbuf(*) get_hdr_rec_size = hdrbuf(1) RETURN END FUNCTION get_hdr_rec_size SUBROUTINE int_gen_write_field_header ( hdrbuf, hdrbufsize, itypesize, ftypesize, & DataHandle , DateStr , VarName , Dummy , FieldType , Comm , IOComm, & DomainDesc , MemoryOrder , Stagger , DimNames , & DomainStart , DomainEnd , & MemoryStart , MemoryEnd , & PatchStart , PatchEnd ) ! !
! Items and their starting locations within a "write field" data header.  
! Assume that the data header is stored in integer vector "hdrbuf":  
!  hdrbuf(1) = hdrbufsize
!  hdrbuf(2) = headerTag
!  hdrbuf(3) = ftypesize
!  hdrbuf(4) = DataHandle
!  hdrbuf(5) = LEN(TRIM(DateStr))
!  hdrbuf(6:5+n1) = DateStr                                          ! n1 = LEN(TRIM(DateStr)) + 1
!  hdrbuf(6+n1) = LEN(TRIM(VarName))
!  hdrbuf(7+n1:6+n1+n2) = VarName                                    ! n2 = LEN(TRIM(VarName)) + 1
!  hdrbuf(7+n1+n2) = FieldType
!  hdrbuf(8+n1+n2) = LEN(TRIM(MemoryOrder))
!  hdrbuf(9+n1+n2:8+n1+n2+n3) = MemoryOrder                          ! n3 = LEN(TRIM(MemoryOrder)) + 1
!  hdrbuf(9+n1+n2+n3) = LEN(TRIM(Stagger))
!  hdrbuf(9+n1+n2+n3:8+n1+n2+n3+n4) = Stagger                        ! n4 = LEN(TRIM(Stagger)) + 1
!  hdrbuf(9+n1+n2+n3+n4) = LEN(TRIM(DimNames(1)))
!  hdrbuf(9+n1+n2+n3+n4:8+n1+n2+n3+n4+n5) = DimNames(1)              ! n5 = LEN(TRIM(DimNames(1))) + 1
!  hdrbuf(9+n1+n2+n3+n4+n5) = LEN(TRIM(DimNames(2)))
!  hdrbuf(9+n1+n2+n3+n4+n5:8+n1+n2+n3+n4+n5+n6) = DimNames(2)        ! n6 = LEN(TRIM(DimNames(2))) + 1
!  hdrbuf(9+n1+n2+n3+n4+n5+n6) = LEN(TRIM(DimNames(3)))
!  hdrbuf(9+n1+n2+n3+n4+n5+n6:8+n1+n2+n3+n4+n5+n6+n7) = DimNames(3)  ! n7 = LEN(TRIM(DimNames(3))) + 1
!  hdrbuf(9+n1+n2+n3+n4+n5+n6+n7) = DomainStart(1)
!  hdrbuf(10+n1+n2+n3+n4+n5+n6+n7) = DomainStart(2)
!  hdrbuf(11+n1+n2+n3+n4+n5+n6+n7) = DomainStart(3)
!  hdrbuf(12+n1+n2+n3+n4+n5+n6+n7) = DomainEnd(1)
!  hdrbuf(13+n1+n2+n3+n4+n5+n6+n7) = DomainEnd(2)
!  hdrbuf(14+n1+n2+n3+n4+n5+n6+n7) = DomainEnd(3)
!  hdrbuf(15+n1+n2+n3+n4+n5+n6+n7) = PatchStart(1)
!  hdrbuf(16+n1+n2+n3+n4+n5+n6+n7) = PatchStart(2)
!  hdrbuf(17+n1+n2+n3+n4+n5+n6+n7) = PatchStart(3)
!  hdrbuf(18+n1+n2+n3+n4+n5+n6+n7) = PatchEnd(1)
!  hdrbuf(19+n1+n2+n3+n4+n5+n6+n7) = PatchEnd(2)
!  hdrbuf(20+n1+n2+n3+n4+n5+n6+n7) = PatchEnd(3)
!  hdrbuf(21+n1+n2+n3+n4+n5+n6+n7) = DomainDesc
!
! Further details for some items:  
!  hdrbufsize:  Size of this data header in bytes.  
!  headerTag:   "Header tag" that tells the I/O quilt servers what kind of 
!               header this is.  For a "write field" header it must be set to 
!               int_field.  See file intio_tags.h for a complete list of 
!               these tags.  
!  ftypesize:   Size of field data type in bytes.  
!  DataHandle:  Descriptor for an open data set.  
!  DomainDesc:  Additional argument that may be used by some packages as a 
!               package-specific domain descriptor.  
!  Other items are described in detail in the "WRF I/O and Model Coupling API 
!  Specification".  
!
!
!
IMPLICIT NONE INTEGER, PARAMETER :: int_ioexit = 10 INTEGER, PARAMETER :: int_open_for_write_begin = 20 INTEGER, PARAMETER :: int_open_for_write_commit = 30 INTEGER, PARAMETER :: int_open_for_read = 40 INTEGER, PARAMETER :: int_inquire_opened = 60 INTEGER, PARAMETER :: int_inquire_filename = 70 INTEGER, PARAMETER :: int_iosync = 80 INTEGER, PARAMETER :: int_ioclose = 90 INTEGER, PARAMETER :: int_next_time = 100 INTEGER, PARAMETER :: int_set_time = 110 INTEGER, PARAMETER :: int_next_var = 120 INTEGER, PARAMETER :: int_dom_ti_real = 140 INTEGER, PARAMETER :: int_dom_ti_double = 160 INTEGER, PARAMETER :: int_dom_ti_integer = 180 INTEGER, PARAMETER :: int_dom_ti_logical = 200 INTEGER, PARAMETER :: int_dom_ti_char = 220 INTEGER, PARAMETER :: int_dom_td_real = 240 INTEGER, PARAMETER :: int_dom_td_double = 260 INTEGER, PARAMETER :: int_dom_td_integer = 280 INTEGER, PARAMETER :: int_dom_td_logical = 300 INTEGER, PARAMETER :: int_dom_td_char = 320 INTEGER, PARAMETER :: int_var_ti_real = 340 INTEGER, PARAMETER :: int_var_ti_double = 360 INTEGER, PARAMETER :: int_var_ti_integer = 380 INTEGER, PARAMETER :: int_var_ti_logical = 400 INTEGER, PARAMETER :: int_var_ti_char = 420 INTEGER, PARAMETER :: int_var_td_real = 440 INTEGER, PARAMETER :: int_var_td_double = 460 INTEGER, PARAMETER :: int_var_td_integer = 480 INTEGER, PARAMETER :: int_var_td_logical = 500 INTEGER, PARAMETER :: int_var_td_char = 520 INTEGER, PARAMETER :: int_field = 530 INTEGER, PARAMETER :: int_var_info = 540 INTEGER, PARAMETER :: int_noop = 550 INTEGER, INTENT(INOUT) :: hdrbuf(*) INTEGER, INTENT(INOUT) :: hdrbufsize INTEGER, INTENT(INOUT) :: itypesize, ftypesize INTEGER , INTENT(IN) :: DataHandle CHARACTER*(*), INTENT(IN) :: DateStr CHARACTER*(*), INTENT(IN) :: VarName REAL, DIMENSION(*) :: Dummy INTEGER ,intent(in) :: FieldType INTEGER ,intent(inout) :: Comm INTEGER ,intent(inout) :: IOComm INTEGER ,intent(in) :: DomainDesc CHARACTER*(*) ,intent(in) :: MemoryOrder CHARACTER*(*) ,intent(in) :: Stagger CHARACTER*(*) , dimension (*) ,intent(in) :: DimNames INTEGER ,dimension(*) ,intent(in) :: DomainStart, DomainEnd INTEGER ,dimension(*) ,intent(in) :: MemoryStart, MemoryEnd INTEGER ,dimension(*) ,intent(in) :: PatchStart, PatchEnd INTEGER i, n hdrbuf(1) = 0 ! deferred -- this will be length of header hdrbuf(2) = int_field hdrbuf(3) = ftypesize i = 4 hdrbuf(i) = DataHandle ; i = i+1 call int_pack_string( DateStr, hdrbuf(i), n ) ; i = i + n call int_pack_string( VarName, hdrbuf(i), n ) ; i = i + n hdrbuf(i) = FieldType ; i = i+1 call int_pack_string( MemoryOrder, hdrbuf(i), n ) ; i = i + n call int_pack_string( Stagger, hdrbuf(i), n ) ; i = i + n call int_pack_string( DimNames(1), hdrbuf(i), n ) ; i = i + n call int_pack_string( DimNames(2), hdrbuf(i), n ) ; i = i + n call int_pack_string( DimNames(3), hdrbuf(i), n ) ; i = i + n hdrbuf(i) = DomainStart(1) ; i = i+1 hdrbuf(i) = DomainStart(2) ; i = i+1 hdrbuf(i) = DomainStart(3) ; i = i+1 hdrbuf(i) = DomainEnd(1) ; i = i+1 hdrbuf(i) = DomainEnd(2) ; i = i+1 hdrbuf(i) = DomainEnd(3) ; i = i+1 hdrbuf(i) = PatchStart(1) ; i = i+1 hdrbuf(i) = PatchStart(2) ; i = i+1 hdrbuf(i) = PatchStart(3) ; i = i+1 hdrbuf(i) = PatchEnd(1) ; i = i+1 hdrbuf(i) = PatchEnd(2) ; i = i+1 hdrbuf(i) = PatchEnd(3) ; i = i+1 hdrbuf(i) = DomainDesc ; i = i+1 hdrbufsize = (i-1) * itypesize ! return the number in bytes hdrbuf(1) = hdrbufsize RETURN END SUBROUTINE int_gen_write_field_header SUBROUTINE int_get_write_field_header ( hdrbuf, hdrbufsize, itypesize, ftypesize, & DataHandle , DateStr , VarName , Dummy , FieldType , Comm , IOComm, & DomainDesc , MemoryOrder , Stagger , DimNames , & DomainStart , DomainEnd , & MemoryStart , MemoryEnd , & PatchStart , PatchEnd ) ! !
! See documentation block in int_gen_write_field_header() for 
! a description of a "write field" header.  
!
!
IMPLICIT NONE INTEGER, PARAMETER :: int_ioexit = 10 INTEGER, PARAMETER :: int_open_for_write_begin = 20 INTEGER, PARAMETER :: int_open_for_write_commit = 30 INTEGER, PARAMETER :: int_open_for_read = 40 INTEGER, PARAMETER :: int_inquire_opened = 60 INTEGER, PARAMETER :: int_inquire_filename = 70 INTEGER, PARAMETER :: int_iosync = 80 INTEGER, PARAMETER :: int_ioclose = 90 INTEGER, PARAMETER :: int_next_time = 100 INTEGER, PARAMETER :: int_set_time = 110 INTEGER, PARAMETER :: int_next_var = 120 INTEGER, PARAMETER :: int_dom_ti_real = 140 INTEGER, PARAMETER :: int_dom_ti_double = 160 INTEGER, PARAMETER :: int_dom_ti_integer = 180 INTEGER, PARAMETER :: int_dom_ti_logical = 200 INTEGER, PARAMETER :: int_dom_ti_char = 220 INTEGER, PARAMETER :: int_dom_td_real = 240 INTEGER, PARAMETER :: int_dom_td_double = 260 INTEGER, PARAMETER :: int_dom_td_integer = 280 INTEGER, PARAMETER :: int_dom_td_logical = 300 INTEGER, PARAMETER :: int_dom_td_char = 320 INTEGER, PARAMETER :: int_var_ti_real = 340 INTEGER, PARAMETER :: int_var_ti_double = 360 INTEGER, PARAMETER :: int_var_ti_integer = 380 INTEGER, PARAMETER :: int_var_ti_logical = 400 INTEGER, PARAMETER :: int_var_ti_char = 420 INTEGER, PARAMETER :: int_var_td_real = 440 INTEGER, PARAMETER :: int_var_td_double = 460 INTEGER, PARAMETER :: int_var_td_integer = 480 INTEGER, PARAMETER :: int_var_td_logical = 500 INTEGER, PARAMETER :: int_var_td_char = 520 INTEGER, PARAMETER :: int_field = 530 INTEGER, PARAMETER :: int_var_info = 540 INTEGER, PARAMETER :: int_noop = 550 INTEGER, INTENT(INOUT) :: hdrbuf(*) INTEGER, INTENT(OUT) :: hdrbufsize INTEGER, INTENT(INOUT) :: itypesize, ftypesize INTEGER , INTENT(OUT) :: DataHandle CHARACTER*(*), INTENT(INOUT) :: DateStr CHARACTER*(*), INTENT(INOUT) :: VarName REAL, DIMENSION(*) :: Dummy INTEGER :: FieldType INTEGER :: Comm INTEGER :: IOComm INTEGER :: DomainDesc CHARACTER*(*) :: MemoryOrder CHARACTER*(*) :: Stagger CHARACTER*(*) , dimension (*) :: DimNames INTEGER ,dimension(*) :: DomainStart, DomainEnd INTEGER ,dimension(*) :: MemoryStart, MemoryEnd INTEGER ,dimension(*) :: PatchStart, PatchEnd !Local CHARACTER*132 mess INTEGER i, n hdrbufsize = hdrbuf(1) IF ( hdrbuf(2) .NE. int_field ) THEN write(mess,*)'int_get_write_field_header: hdrbuf(2) ne int_field ',hdrbuf(2),int_field CALL wrf_error_fatal ( mess ) ENDIF ftypesize = hdrbuf(3) i = 4 DataHandle = hdrbuf(i) ; i = i+1 call int_unpack_string( DateStr, hdrbuf(i), n ) ; i = i+n call int_unpack_string( VarName, hdrbuf(i), n ) ; i = i+n FieldType = hdrbuf(i) ; i = i+1 call int_unpack_string( MemoryOrder, hdrbuf(i), n ) ; i = i+n call int_unpack_string( Stagger, hdrbuf(i), n ) ; i = i+n call int_unpack_string( DimNames(1), hdrbuf(i), n ) ; i = i+n call int_unpack_string( DimNames(2), hdrbuf(i), n ) ; i = i+n call int_unpack_string( DimNames(3), hdrbuf(i), n ) ; i = i+n DomainStart(1) = hdrbuf(i) ; i = i+1 DomainStart(2) = hdrbuf(i) ; i = i+1 DomainStart(3) = hdrbuf(i) ; i = i+1 DomainEnd(1) = hdrbuf(i) ; i = i+1 DomainEnd(2) = hdrbuf(i) ; i = i+1 DomainEnd(3) = hdrbuf(i) ; i = i+1 PatchStart(1) = hdrbuf(i) ; i = i+1 PatchStart(2) = hdrbuf(i) ; i = i+1 PatchStart(3) = hdrbuf(i) ; i = i+1 PatchEnd(1) = hdrbuf(i) ; i = i+1 PatchEnd(2) = hdrbuf(i) ; i = i+1 PatchEnd(3) = hdrbuf(i) ; i = i+1 DomainDesc = hdrbuf(i) ; i = i+1 RETURN END SUBROUTINE int_get_write_field_header !!!!!!!! !generate open for read header SUBROUTINE int_gen_ofr_header( hdrbuf, hdrbufsize, itypesize, & FileName, SysDepInfo, DataHandle ) ! !
! Items and their starting locations within a "open for read" data header.  
! Assume that the data header is stored in integer vector "hdrbuf":  
!  hdrbuf(1) = hdrbufsize
!  hdrbuf(2) = headerTag
!  hdrbuf(3) = DataHandle
!  hdrbuf(4) = LEN(TRIM(FileName))
!  hdrbuf(5:4+n1) = FileName             ! n1 = LEN(TRIM(FileName)) + 1
!  hdrbuf(5+n1) = LEN(TRIM(SysDepInfo))
!  hdrbuf(6+n1:5+n1+n2) = SysDepInfo     ! n2 = LEN(TRIM(SysDepInfo)) + 1
!
! Further details for some items:  
!  hdrbufsize:  Size of this data header in bytes.  
!  headerTag:   "Header tag" that tells the I/O quilt servers what kind of 
!               header this is.  For an "open for read" header it must be set to 
!               int_open_for_read.  See file intio_tags.h for a complete list of 
!               these tags.  
!  DataHandle:  Descriptor for an open data set.  
!  FileName:    File name.  
!  SysDepInfo:  System dependent information used for optional additional 
!               I/O control information.  
!  Other items are described in detail in the "WRF I/O and Model Coupling API 
!  Specification".  
!
!
!
IMPLICIT NONE INTEGER, PARAMETER :: int_ioexit = 10 INTEGER, PARAMETER :: int_open_for_write_begin = 20 INTEGER, PARAMETER :: int_open_for_write_commit = 30 INTEGER, PARAMETER :: int_open_for_read = 40 INTEGER, PARAMETER :: int_inquire_opened = 60 INTEGER, PARAMETER :: int_inquire_filename = 70 INTEGER, PARAMETER :: int_iosync = 80 INTEGER, PARAMETER :: int_ioclose = 90 INTEGER, PARAMETER :: int_next_time = 100 INTEGER, PARAMETER :: int_set_time = 110 INTEGER, PARAMETER :: int_next_var = 120 INTEGER, PARAMETER :: int_dom_ti_real = 140 INTEGER, PARAMETER :: int_dom_ti_double = 160 INTEGER, PARAMETER :: int_dom_ti_integer = 180 INTEGER, PARAMETER :: int_dom_ti_logical = 200 INTEGER, PARAMETER :: int_dom_ti_char = 220 INTEGER, PARAMETER :: int_dom_td_real = 240 INTEGER, PARAMETER :: int_dom_td_double = 260 INTEGER, PARAMETER :: int_dom_td_integer = 280 INTEGER, PARAMETER :: int_dom_td_logical = 300 INTEGER, PARAMETER :: int_dom_td_char = 320 INTEGER, PARAMETER :: int_var_ti_real = 340 INTEGER, PARAMETER :: int_var_ti_double = 360 INTEGER, PARAMETER :: int_var_ti_integer = 380 INTEGER, PARAMETER :: int_var_ti_logical = 400 INTEGER, PARAMETER :: int_var_ti_char = 420 INTEGER, PARAMETER :: int_var_td_real = 440 INTEGER, PARAMETER :: int_var_td_double = 460 INTEGER, PARAMETER :: int_var_td_integer = 480 INTEGER, PARAMETER :: int_var_td_logical = 500 INTEGER, PARAMETER :: int_var_td_char = 520 INTEGER, PARAMETER :: int_field = 530 INTEGER, PARAMETER :: int_var_info = 540 INTEGER, PARAMETER :: int_noop = 550 INTEGER, INTENT(INOUT) :: hdrbuf(*) INTEGER, INTENT(OUT) :: hdrbufsize INTEGER, INTENT(INOUT) :: itypesize INTEGER , INTENT(IN) :: DataHandle CHARACTER*(*), INTENT(INOUT) :: FileName CHARACTER*(*), INTENT(INOUT) :: SysDepInfo !Local INTEGER i, n, i1 ! hdrbuf(1) = 0 !deferred hdrbuf(2) = int_open_for_read i = 3 hdrbuf(i) = DataHandle ; i = i+1 call int_pack_string( TRIM(FileName), hdrbuf(i), n ) ; i = i + n call int_pack_string( TRIM(SysDepInfo), hdrbuf(i), n ) ; i = i + n hdrbufsize = (i-1) * itypesize ! return the number in bytes hdrbuf(1) = hdrbufsize RETURN END SUBROUTINE int_gen_ofr_header !get open for read header SUBROUTINE int_get_ofr_header( hdrbuf, hdrbufsize, itypesize, & FileName, SysDepInfo, DataHandle ) ! !
! See documentation block in int_gen_ofr_header() for 
! a description of a "open for read" header.  
!
!
IMPLICIT NONE INTEGER, PARAMETER :: int_ioexit = 10 INTEGER, PARAMETER :: int_open_for_write_begin = 20 INTEGER, PARAMETER :: int_open_for_write_commit = 30 INTEGER, PARAMETER :: int_open_for_read = 40 INTEGER, PARAMETER :: int_inquire_opened = 60 INTEGER, PARAMETER :: int_inquire_filename = 70 INTEGER, PARAMETER :: int_iosync = 80 INTEGER, PARAMETER :: int_ioclose = 90 INTEGER, PARAMETER :: int_next_time = 100 INTEGER, PARAMETER :: int_set_time = 110 INTEGER, PARAMETER :: int_next_var = 120 INTEGER, PARAMETER :: int_dom_ti_real = 140 INTEGER, PARAMETER :: int_dom_ti_double = 160 INTEGER, PARAMETER :: int_dom_ti_integer = 180 INTEGER, PARAMETER :: int_dom_ti_logical = 200 INTEGER, PARAMETER :: int_dom_ti_char = 220 INTEGER, PARAMETER :: int_dom_td_real = 240 INTEGER, PARAMETER :: int_dom_td_double = 260 INTEGER, PARAMETER :: int_dom_td_integer = 280 INTEGER, PARAMETER :: int_dom_td_logical = 300 INTEGER, PARAMETER :: int_dom_td_char = 320 INTEGER, PARAMETER :: int_var_ti_real = 340 INTEGER, PARAMETER :: int_var_ti_double = 360 INTEGER, PARAMETER :: int_var_ti_integer = 380 INTEGER, PARAMETER :: int_var_ti_logical = 400 INTEGER, PARAMETER :: int_var_ti_char = 420 INTEGER, PARAMETER :: int_var_td_real = 440 INTEGER, PARAMETER :: int_var_td_double = 460 INTEGER, PARAMETER :: int_var_td_integer = 480 INTEGER, PARAMETER :: int_var_td_logical = 500 INTEGER, PARAMETER :: int_var_td_char = 520 INTEGER, PARAMETER :: int_field = 530 INTEGER, PARAMETER :: int_var_info = 540 INTEGER, PARAMETER :: int_noop = 550 INTEGER, INTENT(INOUT) :: hdrbuf(*) INTEGER, INTENT(OUT) :: hdrbufsize INTEGER, INTENT(INOUT) :: itypesize INTEGER , INTENT(OUT) :: DataHandle CHARACTER*(*), INTENT(INOUT) :: FileName CHARACTER*(*), INTENT(INOUT) :: SysDepInfo !Local INTEGER i, n ! hdrbufsize = hdrbuf(1) ! IF ( hdrbuf(2) .NE. int_open_for_read ) THEN ! CALL wrf_error_fatal ( "int_get_ofr_header: hdrbuf ne int_open_for_read") ! ENDIF i = 3 DataHandle = hdrbuf(i) ; i = i+1 call int_unpack_string( FileName, hdrbuf(i), n ) ; i = i+n call int_unpack_string( SysDepInfo, hdrbuf(i), n ) ; i = i+n RETURN END SUBROUTINE int_get_ofr_header !!!!!!!! !generate open for write begin header SUBROUTINE int_gen_ofwb_header( hdrbuf, hdrbufsize, itypesize, & FileName, SysDepInfo, io_form, DataHandle ) ! !
! Items and their starting locations within a "open for write begin" data 
! header.  Assume that the data header is stored in integer vector "hdrbuf":  
!  hdrbuf(1) = hdrbufsize
!  hdrbuf(2) = headerTag
!  hdrbuf(3) = DataHandle
!  hdrbuf(4) = io_form
!  hdrbuf(5) = LEN(TRIM(FileName))
!  hdrbuf(6:5+n1) = FileName             ! n1 = LEN(TRIM(FileName)) + 1
!  hdrbuf(6+n1) = LEN(TRIM(SysDepInfo))
!  hdrbuf(7+n1:6+n1+n2) = SysDepInfo     ! n2 = LEN(TRIM(SysDepInfo)) + 1
!
! Further details for some items:  
!  hdrbufsize:  Size of this data header in bytes.  
!  headerTag:   "Header tag" that tells the I/O quilt servers what kind of 
!               header this is.  For an "open for write begin" header it must be set to 
!               int_open_for_write_begin.  See file intio_tags.h for a complete list of 
!               these tags.  
!  DataHandle:  Descriptor for an open data set.  
!  io_form:     I/O format for this file (netCDF, etc.).  
!  FileName:    File name.  
!  SysDepInfo:  System dependent information used for optional additional 
!               I/O control information.  
!  Other items are described in detail in the "WRF I/O and Model Coupling API 
!  Specification".  
!
!
!
IMPLICIT NONE INTEGER, PARAMETER :: int_ioexit = 10 INTEGER, PARAMETER :: int_open_for_write_begin = 20 INTEGER, PARAMETER :: int_open_for_write_commit = 30 INTEGER, PARAMETER :: int_open_for_read = 40 INTEGER, PARAMETER :: int_inquire_opened = 60 INTEGER, PARAMETER :: int_inquire_filename = 70 INTEGER, PARAMETER :: int_iosync = 80 INTEGER, PARAMETER :: int_ioclose = 90 INTEGER, PARAMETER :: int_next_time = 100 INTEGER, PARAMETER :: int_set_time = 110 INTEGER, PARAMETER :: int_next_var = 120 INTEGER, PARAMETER :: int_dom_ti_real = 140 INTEGER, PARAMETER :: int_dom_ti_double = 160 INTEGER, PARAMETER :: int_dom_ti_integer = 180 INTEGER, PARAMETER :: int_dom_ti_logical = 200 INTEGER, PARAMETER :: int_dom_ti_char = 220 INTEGER, PARAMETER :: int_dom_td_real = 240 INTEGER, PARAMETER :: int_dom_td_double = 260 INTEGER, PARAMETER :: int_dom_td_integer = 280 INTEGER, PARAMETER :: int_dom_td_logical = 300 INTEGER, PARAMETER :: int_dom_td_char = 320 INTEGER, PARAMETER :: int_var_ti_real = 340 INTEGER, PARAMETER :: int_var_ti_double = 360 INTEGER, PARAMETER :: int_var_ti_integer = 380 INTEGER, PARAMETER :: int_var_ti_logical = 400 INTEGER, PARAMETER :: int_var_ti_char = 420 INTEGER, PARAMETER :: int_var_td_real = 440 INTEGER, PARAMETER :: int_var_td_double = 460 INTEGER, PARAMETER :: int_var_td_integer = 480 INTEGER, PARAMETER :: int_var_td_logical = 500 INTEGER, PARAMETER :: int_var_td_char = 520 INTEGER, PARAMETER :: int_field = 530 INTEGER, PARAMETER :: int_var_info = 540 INTEGER, PARAMETER :: int_noop = 550 INTEGER, INTENT(INOUT) :: hdrbuf(*) INTEGER, INTENT(OUT) :: hdrbufsize INTEGER, INTENT(INOUT) :: itypesize INTEGER , INTENT(IN) :: io_form INTEGER , INTENT(IN) :: DataHandle CHARACTER*(*), INTENT(INOUT) :: FileName CHARACTER*(*), INTENT(INOUT) :: SysDepInfo !Local INTEGER i, n, j ! hdrbuf(1) = 0 !deferred hdrbuf(2) = int_open_for_write_begin i = 3 hdrbuf(i) = DataHandle ; i = i+1 hdrbuf(i) = io_form ; i = i+1 !j = i call int_pack_string( FileName, hdrbuf(i), n ) ; i = i + n !write(0,*)'int_gen_ofwb_header FileName ',TRIM(FileName),hdrbuf(j),n !j = i call int_pack_string( SysDepInfo, hdrbuf(i), n ) ; i = i + n !write(0,*)'int_gen_ofwb_header SysDepInfo ',TRIM(SysDepInfo),hdrbuf(j),n hdrbufsize = (i-1) * itypesize ! return the number in bytes hdrbuf(1) = hdrbufsize !write(0,*)'int_gen_ofwb_header hdrbuf(1) ',hdrbuf(1) RETURN END SUBROUTINE int_gen_ofwb_header !get open for write begin header SUBROUTINE int_get_ofwb_header( hdrbuf, hdrbufsize, itypesize, & FileName, SysDepInfo, io_form, DataHandle ) ! !
! See documentation block in int_gen_ofwb_header() for 
! a description of a "open for write begin" header.  
!
!
IMPLICIT NONE INTEGER, PARAMETER :: int_ioexit = 10 INTEGER, PARAMETER :: int_open_for_write_begin = 20 INTEGER, PARAMETER :: int_open_for_write_commit = 30 INTEGER, PARAMETER :: int_open_for_read = 40 INTEGER, PARAMETER :: int_inquire_opened = 60 INTEGER, PARAMETER :: int_inquire_filename = 70 INTEGER, PARAMETER :: int_iosync = 80 INTEGER, PARAMETER :: int_ioclose = 90 INTEGER, PARAMETER :: int_next_time = 100 INTEGER, PARAMETER :: int_set_time = 110 INTEGER, PARAMETER :: int_next_var = 120 INTEGER, PARAMETER :: int_dom_ti_real = 140 INTEGER, PARAMETER :: int_dom_ti_double = 160 INTEGER, PARAMETER :: int_dom_ti_integer = 180 INTEGER, PARAMETER :: int_dom_ti_logical = 200 INTEGER, PARAMETER :: int_dom_ti_char = 220 INTEGER, PARAMETER :: int_dom_td_real = 240 INTEGER, PARAMETER :: int_dom_td_double = 260 INTEGER, PARAMETER :: int_dom_td_integer = 280 INTEGER, PARAMETER :: int_dom_td_logical = 300 INTEGER, PARAMETER :: int_dom_td_char = 320 INTEGER, PARAMETER :: int_var_ti_real = 340 INTEGER, PARAMETER :: int_var_ti_double = 360 INTEGER, PARAMETER :: int_var_ti_integer = 380 INTEGER, PARAMETER :: int_var_ti_logical = 400 INTEGER, PARAMETER :: int_var_ti_char = 420 INTEGER, PARAMETER :: int_var_td_real = 440 INTEGER, PARAMETER :: int_var_td_double = 460 INTEGER, PARAMETER :: int_var_td_integer = 480 INTEGER, PARAMETER :: int_var_td_logical = 500 INTEGER, PARAMETER :: int_var_td_char = 520 INTEGER, PARAMETER :: int_field = 530 INTEGER, PARAMETER :: int_var_info = 540 INTEGER, PARAMETER :: int_noop = 550 INTEGER, INTENT(INOUT) :: hdrbuf(*) INTEGER, INTENT(OUT) :: hdrbufsize INTEGER, INTENT(INOUT) :: itypesize INTEGER , INTENT(OUT) :: DataHandle INTEGER , INTENT(OUT) :: io_form CHARACTER*(*), INTENT (INOUT) :: FileName CHARACTER*(*), INTENT (INOUT) :: SysDepInfo !Local INTEGER i, n, j ! hdrbufsize = hdrbuf(1) !write(0,*)' int_get_ofwb_header next rec start ',hdrbuf(hdrbufsize+1) ! IF ( hdrbuf(2) .NE. int_open_for_write_begin ) THEN ! CALL wrf_error_fatal ( "int_get_ofwb_header: hdrbuf ne int_open_for_write_begin") ! ENDIF i = 3 DataHandle = hdrbuf(i) ; i = i+1 !write(0,*)' int_get_ofwb_header next rec',i, hdrbuf(hdrbufsize+1) io_form = hdrbuf(i) ; i = i+1 !write(0,*)' int_get_ofwb_header next rec',i, hdrbuf(hdrbufsize+1) !j = i call int_unpack_string( FileName, hdrbuf(i), n ) ; i = i+n !write(0,*)'int_get_ofwb_header FileName ',TRIM(FileName),hdrbuf(j),n !write(0,*)' int_get_ofwb_header next rec',i, hdrbuf(hdrbufsize+1) !j = i call int_unpack_string( SysDepInfo, hdrbuf(i), n ) ; i = i+n !write(0,*)'int_get_ofwb_header SysDepInfo ',TRIM(SysDepInfo),hdrbuf(j),n !write(0,*)' int_get_ofwb_header next rec',i, hdrbuf(hdrbufsize+1) !write(0,*)'int_get_ofwb_header hdrbufsize ',hdrbufsize RETURN END SUBROUTINE int_get_ofwb_header !!!!!!!!!! SUBROUTINE int_gen_handle_header( hdrbuf, hdrbufsize, itypesize, & DataHandle , code ) ! !
! Items and their starting locations within a "generic handle" data header.  
! Several types of data headers contain only a DataHandle and a header tag 
! (I/O command).  This routine is used for all of them.  Assume that 
! the data header is stored in integer vector "hdrbuf":  
!  hdrbuf(1) = hdrbufsize
!  hdrbuf(2) = headerTag
!  hdrbuf(3) = DataHandle
!
! Further details for some items:  
!  hdrbufsize:  Size of this data header in bytes.  
!  headerTag:   "Header tag" that tells the I/O quilt servers what kind of 
!               header this is.  For a "generic handle" header there are 
!               several possible values.  In this routine, dummy argument 
!               "code" is used as headerTag.  
!  DataHandle:  Descriptor for an open data set.  
!
!
!
IMPLICIT NONE INTEGER, PARAMETER :: int_ioexit = 10 INTEGER, PARAMETER :: int_open_for_write_begin = 20 INTEGER, PARAMETER :: int_open_for_write_commit = 30 INTEGER, PARAMETER :: int_open_for_read = 40 INTEGER, PARAMETER :: int_inquire_opened = 60 INTEGER, PARAMETER :: int_inquire_filename = 70 INTEGER, PARAMETER :: int_iosync = 80 INTEGER, PARAMETER :: int_ioclose = 90 INTEGER, PARAMETER :: int_next_time = 100 INTEGER, PARAMETER :: int_set_time = 110 INTEGER, PARAMETER :: int_next_var = 120 INTEGER, PARAMETER :: int_dom_ti_real = 140 INTEGER, PARAMETER :: int_dom_ti_double = 160 INTEGER, PARAMETER :: int_dom_ti_integer = 180 INTEGER, PARAMETER :: int_dom_ti_logical = 200 INTEGER, PARAMETER :: int_dom_ti_char = 220 INTEGER, PARAMETER :: int_dom_td_real = 240 INTEGER, PARAMETER :: int_dom_td_double = 260 INTEGER, PARAMETER :: int_dom_td_integer = 280 INTEGER, PARAMETER :: int_dom_td_logical = 300 INTEGER, PARAMETER :: int_dom_td_char = 320 INTEGER, PARAMETER :: int_var_ti_real = 340 INTEGER, PARAMETER :: int_var_ti_double = 360 INTEGER, PARAMETER :: int_var_ti_integer = 380 INTEGER, PARAMETER :: int_var_ti_logical = 400 INTEGER, PARAMETER :: int_var_ti_char = 420 INTEGER, PARAMETER :: int_var_td_real = 440 INTEGER, PARAMETER :: int_var_td_double = 460 INTEGER, PARAMETER :: int_var_td_integer = 480 INTEGER, PARAMETER :: int_var_td_logical = 500 INTEGER, PARAMETER :: int_var_td_char = 520 INTEGER, PARAMETER :: int_field = 530 INTEGER, PARAMETER :: int_var_info = 540 INTEGER, PARAMETER :: int_noop = 550 INTEGER, INTENT(INOUT) :: hdrbuf(*) INTEGER, INTENT(OUT) :: hdrbufsize INTEGER, INTENT(INOUT) :: itypesize INTEGER ,INTENT(IN) :: DataHandle, code !Local INTEGER i ! hdrbuf(1) = 0 !deferred hdrbuf(2) = code i = 3 hdrbuf(i) = DataHandle ; i = i+1 hdrbufsize = (i-1) * itypesize ! return the number in bytes hdrbuf(1) = hdrbufsize RETURN END SUBROUTINE int_gen_handle_header SUBROUTINE int_get_handle_header( hdrbuf, hdrbufsize, itypesize, & DataHandle , code ) ! !
! See documentation block in int_gen_handle_header() for 
! a description of a "generic handle" header.  
!
!
IMPLICIT NONE INTEGER, PARAMETER :: int_ioexit = 10 INTEGER, PARAMETER :: int_open_for_write_begin = 20 INTEGER, PARAMETER :: int_open_for_write_commit = 30 INTEGER, PARAMETER :: int_open_for_read = 40 INTEGER, PARAMETER :: int_inquire_opened = 60 INTEGER, PARAMETER :: int_inquire_filename = 70 INTEGER, PARAMETER :: int_iosync = 80 INTEGER, PARAMETER :: int_ioclose = 90 INTEGER, PARAMETER :: int_next_time = 100 INTEGER, PARAMETER :: int_set_time = 110 INTEGER, PARAMETER :: int_next_var = 120 INTEGER, PARAMETER :: int_dom_ti_real = 140 INTEGER, PARAMETER :: int_dom_ti_double = 160 INTEGER, PARAMETER :: int_dom_ti_integer = 180 INTEGER, PARAMETER :: int_dom_ti_logical = 200 INTEGER, PARAMETER :: int_dom_ti_char = 220 INTEGER, PARAMETER :: int_dom_td_real = 240 INTEGER, PARAMETER :: int_dom_td_double = 260 INTEGER, PARAMETER :: int_dom_td_integer = 280 INTEGER, PARAMETER :: int_dom_td_logical = 300 INTEGER, PARAMETER :: int_dom_td_char = 320 INTEGER, PARAMETER :: int_var_ti_real = 340 INTEGER, PARAMETER :: int_var_ti_double = 360 INTEGER, PARAMETER :: int_var_ti_integer = 380 INTEGER, PARAMETER :: int_var_ti_logical = 400 INTEGER, PARAMETER :: int_var_ti_char = 420 INTEGER, PARAMETER :: int_var_td_real = 440 INTEGER, PARAMETER :: int_var_td_double = 460 INTEGER, PARAMETER :: int_var_td_integer = 480 INTEGER, PARAMETER :: int_var_td_logical = 500 INTEGER, PARAMETER :: int_var_td_char = 520 INTEGER, PARAMETER :: int_field = 530 INTEGER, PARAMETER :: int_var_info = 540 INTEGER, PARAMETER :: int_noop = 550 INTEGER, INTENT(INOUT) :: hdrbuf(*) INTEGER, INTENT(OUT) :: hdrbufsize INTEGER, INTENT(INOUT) :: itypesize INTEGER ,INTENT(OUT) :: DataHandle, code !Local INTEGER i ! hdrbufsize = hdrbuf(1) code = hdrbuf(2) i = 3 DataHandle = hdrbuf(i) ; i = i+1 RETURN END SUBROUTINE int_get_handle_header !!!!!!!!!!!! SUBROUTINE int_gen_ti_header_integer( hdrbuf, hdrbufsize, itypesize, typesize, & DataHandle, Element, Data, Count, code ) ! !
! Items and their starting locations within a "time-independent integer" 
! data header.  Assume that the data header is stored in integer vector 
! "hdrbuf":  
!  hdrbuf(1) = hdrbufsize
!  hdrbuf(2) = headerTag
!  hdrbuf(3) = DataHandle
!  hdrbuf(4) = typesize
!  hdrbuf(5) = Count
!  hdrbuf(6:6+n1) = Data              ! n1 = (Count * typesize / itypesize) + 1
!  hdrbuf(7+n1) = LEN(TRIM(Element))
!  hdrbuf(8+n1:7+n1+n2) = Element     ! n2 = LEN(TRIM(Element)) + 1
!
! Further details for some items:  
!  hdrbufsize:  Size of this data header in bytes.  
!  headerTag:   "Header tag" that tells the I/O quilt servers what kind of 
!               header this is.  For an "time-independent integer" header it must be 
!               set to int_dom_ti_integer.  See file intio_tags.h for a complete 
!               list of these tags.  
!  DataHandle:  Descriptor for an open data set.  
!  typesize:    Size in bytes of each element of Data.  
!  Count:       Number of elements in Data.  
!  Data:        Data to write to file.  
!  Element:     Name of the data.  
!  Other items are described in detail in the "WRF I/O and Model Coupling API 
!  Specification".  
!
!
!
IMPLICIT NONE INTEGER, PARAMETER :: int_ioexit = 10 INTEGER, PARAMETER :: int_open_for_write_begin = 20 INTEGER, PARAMETER :: int_open_for_write_commit = 30 INTEGER, PARAMETER :: int_open_for_read = 40 INTEGER, PARAMETER :: int_inquire_opened = 60 INTEGER, PARAMETER :: int_inquire_filename = 70 INTEGER, PARAMETER :: int_iosync = 80 INTEGER, PARAMETER :: int_ioclose = 90 INTEGER, PARAMETER :: int_next_time = 100 INTEGER, PARAMETER :: int_set_time = 110 INTEGER, PARAMETER :: int_next_var = 120 INTEGER, PARAMETER :: int_dom_ti_real = 140 INTEGER, PARAMETER :: int_dom_ti_double = 160 INTEGER, PARAMETER :: int_dom_ti_integer = 180 INTEGER, PARAMETER :: int_dom_ti_logical = 200 INTEGER, PARAMETER :: int_dom_ti_char = 220 INTEGER, PARAMETER :: int_dom_td_real = 240 INTEGER, PARAMETER :: int_dom_td_double = 260 INTEGER, PARAMETER :: int_dom_td_integer = 280 INTEGER, PARAMETER :: int_dom_td_logical = 300 INTEGER, PARAMETER :: int_dom_td_char = 320 INTEGER, PARAMETER :: int_var_ti_real = 340 INTEGER, PARAMETER :: int_var_ti_double = 360 INTEGER, PARAMETER :: int_var_ti_integer = 380 INTEGER, PARAMETER :: int_var_ti_logical = 400 INTEGER, PARAMETER :: int_var_ti_char = 420 INTEGER, PARAMETER :: int_var_td_real = 440 INTEGER, PARAMETER :: int_var_td_double = 460 INTEGER, PARAMETER :: int_var_td_integer = 480 INTEGER, PARAMETER :: int_var_td_logical = 500 INTEGER, PARAMETER :: int_var_td_char = 520 INTEGER, PARAMETER :: int_field = 530 INTEGER, PARAMETER :: int_var_info = 540 INTEGER, PARAMETER :: int_noop = 550 INTEGER, INTENT(INOUT) :: hdrbuf(*) INTEGER, INTENT(OUT) :: hdrbufsize INTEGER, INTENT(IN) :: itypesize, typesize CHARACTER*(*), INTENT(INOUT) :: Element INTEGER, INTENT(IN) :: Data(*) INTEGER, INTENT(IN) :: DataHandle, Count, code !Local INTEGER i, n ! CALL int_gen_ti_header_c ( hdrbuf, hdrbufsize, itypesize, typesize, & DataHandle, Data, Count, code ) i = hdrbufsize/itypesize + 1 ; !write(0,*)'int_gen_ti_header_integer ',TRIM(Element) CALL int_pack_string ( Element, hdrbuf( i ), n ) ; i = i + n hdrbufsize = n * itypesize + hdrbufsize ! return the number in bytes hdrbuf(1) = hdrbufsize RETURN END SUBROUTINE int_gen_ti_header_integer SUBROUTINE int_gen_ti_header_integer_varna( hdrbuf, hdrbufsize, itypesize, typesize, & DataHandle, Element, VarName, Data, Count, code ) ! !
! Items and their starting locations within a "time-independent integer"
! data header.  Assume that the data header is stored in integer vector
! "hdrbuf":
!  hdrbuf(1) = hdrbufsize
!  hdrbuf(2) = headerTag
!  hdrbuf(3) = DataHandle
!  hdrbuf(4) = typesize
!  hdrbuf(5) = Count
!  hdrbuf(6:6+n1) = Data              ! n1 = (Count * typesize / itypesize) + 1
!  hdrbuf(7+n1) = LEN(TRIM(Element))
!  hdrbuf(8+n1:7+n1+n2) = Element     ! n2 = LEN(TRIM(Element)) + 1
!  hdrbuf(8+n1+n2) = LEN(TRIM(VarName)) = n3
!  hderbuf(9+n1+n2:8+n1+n2+n3) = TRIM(VarName)
!
! Further details for some items:
!  hdrbufsize:  Size of this data header in bytes.
!  headerTag:   "Header tag" that tells the I/O quilt servers what kind of
!               header this is.  For an "time-independent integer" header it must be
!               set to int_dom_ti_integer.  See file intio_tags.h for a complete
!               list of these tags.
!  DataHandle:  Descriptor for an open data set.
!  typesize:    Size in bytes of each element of Data.
!  Count:       Number of elements in Data.
!  Data:        Data to write to file.
!  Element:     Name of the data.
!  VarName:     Variable name.  Used for *__var_ti_char but not for
!               *__dom_ti_char.
!  Other items are described in detail in the "WRF I/O and Model Coupling API
!  Specification".
!
!
!
IMPLICIT NONE INTEGER, PARAMETER :: int_ioexit = 10 INTEGER, PARAMETER :: int_open_for_write_begin = 20 INTEGER, PARAMETER :: int_open_for_write_commit = 30 INTEGER, PARAMETER :: int_open_for_read = 40 INTEGER, PARAMETER :: int_inquire_opened = 60 INTEGER, PARAMETER :: int_inquire_filename = 70 INTEGER, PARAMETER :: int_iosync = 80 INTEGER, PARAMETER :: int_ioclose = 90 INTEGER, PARAMETER :: int_next_time = 100 INTEGER, PARAMETER :: int_set_time = 110 INTEGER, PARAMETER :: int_next_var = 120 INTEGER, PARAMETER :: int_dom_ti_real = 140 INTEGER, PARAMETER :: int_dom_ti_double = 160 INTEGER, PARAMETER :: int_dom_ti_integer = 180 INTEGER, PARAMETER :: int_dom_ti_logical = 200 INTEGER, PARAMETER :: int_dom_ti_char = 220 INTEGER, PARAMETER :: int_dom_td_real = 240 INTEGER, PARAMETER :: int_dom_td_double = 260 INTEGER, PARAMETER :: int_dom_td_integer = 280 INTEGER, PARAMETER :: int_dom_td_logical = 300 INTEGER, PARAMETER :: int_dom_td_char = 320 INTEGER, PARAMETER :: int_var_ti_real = 340 INTEGER, PARAMETER :: int_var_ti_double = 360 INTEGER, PARAMETER :: int_var_ti_integer = 380 INTEGER, PARAMETER :: int_var_ti_logical = 400 INTEGER, PARAMETER :: int_var_ti_char = 420 INTEGER, PARAMETER :: int_var_td_real = 440 INTEGER, PARAMETER :: int_var_td_double = 460 INTEGER, PARAMETER :: int_var_td_integer = 480 INTEGER, PARAMETER :: int_var_td_logical = 500 INTEGER, PARAMETER :: int_var_td_char = 520 INTEGER, PARAMETER :: int_field = 530 INTEGER, PARAMETER :: int_var_info = 540 INTEGER, PARAMETER :: int_noop = 550 INTEGER, INTENT(INOUT) :: hdrbuf(*) INTEGER, INTENT(OUT) :: hdrbufsize INTEGER, INTENT(IN) :: itypesize, typesize CHARACTER*(*), INTENT(IN) :: Element, VarName INTEGER, INTENT(IN) :: Data(*) INTEGER, INTENT(IN) :: DataHandle, Count, code !Local INTEGER i, n ! CALL int_gen_ti_header_c ( hdrbuf, hdrbufsize, itypesize, typesize, & DataHandle, Data, Count, code ) i = hdrbufsize/itypesize + 1 ; !write(0,*)'int_gen_ti_header_integer ',TRIM(Element) CALL int_pack_string ( Element, hdrbuf( i ), n ) ; i = i + n CALL int_pack_string ( VarName, hdrbuf( i ), n ) ; i = i + n hdrbufsize = i * itypesize + hdrbufsize ! return the number in bytes hdrbuf(1) = hdrbufsize RETURN END SUBROUTINE int_gen_ti_header_integer_varna SUBROUTINE int_gen_ti_header_real( hdrbuf, hdrbufsize, itypesize, typesize, & DataHandle, Element, Data, Count, code ) ! !
! Same as int_gen_ti_header_integer except that Data has type REAL.  
!
!
IMPLICIT NONE INTEGER, PARAMETER :: int_ioexit = 10 INTEGER, PARAMETER :: int_open_for_write_begin = 20 INTEGER, PARAMETER :: int_open_for_write_commit = 30 INTEGER, PARAMETER :: int_open_for_read = 40 INTEGER, PARAMETER :: int_inquire_opened = 60 INTEGER, PARAMETER :: int_inquire_filename = 70 INTEGER, PARAMETER :: int_iosync = 80 INTEGER, PARAMETER :: int_ioclose = 90 INTEGER, PARAMETER :: int_next_time = 100 INTEGER, PARAMETER :: int_set_time = 110 INTEGER, PARAMETER :: int_next_var = 120 INTEGER, PARAMETER :: int_dom_ti_real = 140 INTEGER, PARAMETER :: int_dom_ti_double = 160 INTEGER, PARAMETER :: int_dom_ti_integer = 180 INTEGER, PARAMETER :: int_dom_ti_logical = 200 INTEGER, PARAMETER :: int_dom_ti_char = 220 INTEGER, PARAMETER :: int_dom_td_real = 240 INTEGER, PARAMETER :: int_dom_td_double = 260 INTEGER, PARAMETER :: int_dom_td_integer = 280 INTEGER, PARAMETER :: int_dom_td_logical = 300 INTEGER, PARAMETER :: int_dom_td_char = 320 INTEGER, PARAMETER :: int_var_ti_real = 340 INTEGER, PARAMETER :: int_var_ti_double = 360 INTEGER, PARAMETER :: int_var_ti_integer = 380 INTEGER, PARAMETER :: int_var_ti_logical = 400 INTEGER, PARAMETER :: int_var_ti_char = 420 INTEGER, PARAMETER :: int_var_td_real = 440 INTEGER, PARAMETER :: int_var_td_double = 460 INTEGER, PARAMETER :: int_var_td_integer = 480 INTEGER, PARAMETER :: int_var_td_logical = 500 INTEGER, PARAMETER :: int_var_td_char = 520 INTEGER, PARAMETER :: int_field = 530 INTEGER, PARAMETER :: int_var_info = 540 INTEGER, PARAMETER :: int_noop = 550 INTEGER, INTENT(INOUT) :: hdrbuf(*) INTEGER, INTENT(OUT) :: hdrbufsize INTEGER, INTENT(IN) :: itypesize, typesize CHARACTER*(*), INTENT(INOUT) :: Element REAL, INTENT(IN) :: Data(*) INTEGER, INTENT(IN) :: DataHandle, Count, code !Local INTEGER i, n ! CALL int_gen_ti_header_c ( hdrbuf, hdrbufsize, itypesize, typesize, & DataHandle, Data, Count, code ) i = hdrbufsize/itypesize + 1 ; !write(0,*)'int_gen_ti_header_real ',TRIM(Element) CALL int_pack_string ( Element, hdrbuf( i ), n ) ; i = i + n hdrbufsize = n * itypesize + hdrbufsize ! return the number in bytes hdrbuf(1) = hdrbufsize RETURN END SUBROUTINE int_gen_ti_header_real SUBROUTINE int_get_ti_header_integer_varna( hdrbuf, hdrbufsize, itypesize, typesize, & DataHandle, Element, VarName, Data, Count, code) ! !
! Same as int_gen_ti_header_integer except that Data is read from
! the file.
!
!
IMPLICIT NONE INTEGER, PARAMETER :: int_ioexit = 10 INTEGER, PARAMETER :: int_open_for_write_begin = 20 INTEGER, PARAMETER :: int_open_for_write_commit = 30 INTEGER, PARAMETER :: int_open_for_read = 40 INTEGER, PARAMETER :: int_inquire_opened = 60 INTEGER, PARAMETER :: int_inquire_filename = 70 INTEGER, PARAMETER :: int_iosync = 80 INTEGER, PARAMETER :: int_ioclose = 90 INTEGER, PARAMETER :: int_next_time = 100 INTEGER, PARAMETER :: int_set_time = 110 INTEGER, PARAMETER :: int_next_var = 120 INTEGER, PARAMETER :: int_dom_ti_real = 140 INTEGER, PARAMETER :: int_dom_ti_double = 160 INTEGER, PARAMETER :: int_dom_ti_integer = 180 INTEGER, PARAMETER :: int_dom_ti_logical = 200 INTEGER, PARAMETER :: int_dom_ti_char = 220 INTEGER, PARAMETER :: int_dom_td_real = 240 INTEGER, PARAMETER :: int_dom_td_double = 260 INTEGER, PARAMETER :: int_dom_td_integer = 280 INTEGER, PARAMETER :: int_dom_td_logical = 300 INTEGER, PARAMETER :: int_dom_td_char = 320 INTEGER, PARAMETER :: int_var_ti_real = 340 INTEGER, PARAMETER :: int_var_ti_double = 360 INTEGER, PARAMETER :: int_var_ti_integer = 380 INTEGER, PARAMETER :: int_var_ti_logical = 400 INTEGER, PARAMETER :: int_var_ti_char = 420 INTEGER, PARAMETER :: int_var_td_real = 440 INTEGER, PARAMETER :: int_var_td_double = 460 INTEGER, PARAMETER :: int_var_td_integer = 480 INTEGER, PARAMETER :: int_var_td_logical = 500 INTEGER, PARAMETER :: int_var_td_char = 520 INTEGER, PARAMETER :: int_field = 530 INTEGER, PARAMETER :: int_var_info = 540 INTEGER, PARAMETER :: int_noop = 550 INTEGER, INTENT(INOUT) :: hdrbuf(*) INTEGER, INTENT(OUT) :: hdrbufsize INTEGER, INTENT(IN) :: itypesize, typesize CHARACTER*(*), INTENT(INOUT) :: Element, VarName INTEGER, INTENT(OUT) :: Data(*) INTEGER, INTENT(OUT) :: DataHandle, Count, code !Local INTEGER i, n ! CALL int_get_ti_header_c ( hdrbuf, hdrbufsize, n, itypesize, typesize, & DataHandle, Data, Count, code ) i = n/itypesize + 1 CALL int_unpack_string ( Element, hdrbuf( i ), n ) ; i=i+n; CALL int_unpack_string ( VarName, hdrbuf( i ), n ) ; i = i + n ! write(0,*)'int_get_ti_header_integer_varna "', & ! TRIM(Element),'" "', TRIM(VarName),'" data(1)=',Data(1) hdrbufsize = hdrbuf(1) RETURN END SUBROUTINE int_get_ti_header_integer_varna SUBROUTINE int_get_ti_header_integer( hdrbuf, hdrbufsize, itypesize, typesize, & DataHandle, Element, Data, Count, code ) ! !
! Same as int_gen_ti_header_integer except that Data is read from 
! the file.  
!
!
IMPLICIT NONE INTEGER, PARAMETER :: int_ioexit = 10 INTEGER, PARAMETER :: int_open_for_write_begin = 20 INTEGER, PARAMETER :: int_open_for_write_commit = 30 INTEGER, PARAMETER :: int_open_for_read = 40 INTEGER, PARAMETER :: int_inquire_opened = 60 INTEGER, PARAMETER :: int_inquire_filename = 70 INTEGER, PARAMETER :: int_iosync = 80 INTEGER, PARAMETER :: int_ioclose = 90 INTEGER, PARAMETER :: int_next_time = 100 INTEGER, PARAMETER :: int_set_time = 110 INTEGER, PARAMETER :: int_next_var = 120 INTEGER, PARAMETER :: int_dom_ti_real = 140 INTEGER, PARAMETER :: int_dom_ti_double = 160 INTEGER, PARAMETER :: int_dom_ti_integer = 180 INTEGER, PARAMETER :: int_dom_ti_logical = 200 INTEGER, PARAMETER :: int_dom_ti_char = 220 INTEGER, PARAMETER :: int_dom_td_real = 240 INTEGER, PARAMETER :: int_dom_td_double = 260 INTEGER, PARAMETER :: int_dom_td_integer = 280 INTEGER, PARAMETER :: int_dom_td_logical = 300 INTEGER, PARAMETER :: int_dom_td_char = 320 INTEGER, PARAMETER :: int_var_ti_real = 340 INTEGER, PARAMETER :: int_var_ti_double = 360 INTEGER, PARAMETER :: int_var_ti_integer = 380 INTEGER, PARAMETER :: int_var_ti_logical = 400 INTEGER, PARAMETER :: int_var_ti_char = 420 INTEGER, PARAMETER :: int_var_td_real = 440 INTEGER, PARAMETER :: int_var_td_double = 460 INTEGER, PARAMETER :: int_var_td_integer = 480 INTEGER, PARAMETER :: int_var_td_logical = 500 INTEGER, PARAMETER :: int_var_td_char = 520 INTEGER, PARAMETER :: int_field = 530 INTEGER, PARAMETER :: int_var_info = 540 INTEGER, PARAMETER :: int_noop = 550 INTEGER, INTENT(INOUT) :: hdrbuf(*) INTEGER, INTENT(OUT) :: hdrbufsize INTEGER, INTENT(IN) :: itypesize, typesize CHARACTER*(*), INTENT(INOUT) :: Element INTEGER, INTENT(OUT) :: Data(*) INTEGER, INTENT(OUT) :: DataHandle, Count, code !Local INTEGER i, n ! CALL int_get_ti_header_c ( hdrbuf, hdrbufsize, n, itypesize, typesize, & DataHandle, Data, Count, code ) i = 1 CALL int_unpack_string ( Element, hdrbuf( n/itypesize + 1 ), n ) ; !write(0,*)'int_get_ti_header_integer ',TRIM(Element), Data(1) hdrbufsize = hdrbuf(1) RETURN END SUBROUTINE int_get_ti_header_integer SUBROUTINE int_get_ti_header_real( hdrbuf, hdrbufsize, itypesize, typesize, & DataHandle, Element, Data, Count, code ) ! !
! Same as int_gen_ti_header_real except that Data is read from 
! the file.  
!
!
IMPLICIT NONE INTEGER, PARAMETER :: int_ioexit = 10 INTEGER, PARAMETER :: int_open_for_write_begin = 20 INTEGER, PARAMETER :: int_open_for_write_commit = 30 INTEGER, PARAMETER :: int_open_for_read = 40 INTEGER, PARAMETER :: int_inquire_opened = 60 INTEGER, PARAMETER :: int_inquire_filename = 70 INTEGER, PARAMETER :: int_iosync = 80 INTEGER, PARAMETER :: int_ioclose = 90 INTEGER, PARAMETER :: int_next_time = 100 INTEGER, PARAMETER :: int_set_time = 110 INTEGER, PARAMETER :: int_next_var = 120 INTEGER, PARAMETER :: int_dom_ti_real = 140 INTEGER, PARAMETER :: int_dom_ti_double = 160 INTEGER, PARAMETER :: int_dom_ti_integer = 180 INTEGER, PARAMETER :: int_dom_ti_logical = 200 INTEGER, PARAMETER :: int_dom_ti_char = 220 INTEGER, PARAMETER :: int_dom_td_real = 240 INTEGER, PARAMETER :: int_dom_td_double = 260 INTEGER, PARAMETER :: int_dom_td_integer = 280 INTEGER, PARAMETER :: int_dom_td_logical = 300 INTEGER, PARAMETER :: int_dom_td_char = 320 INTEGER, PARAMETER :: int_var_ti_real = 340 INTEGER, PARAMETER :: int_var_ti_double = 360 INTEGER, PARAMETER :: int_var_ti_integer = 380 INTEGER, PARAMETER :: int_var_ti_logical = 400 INTEGER, PARAMETER :: int_var_ti_char = 420 INTEGER, PARAMETER :: int_var_td_real = 440 INTEGER, PARAMETER :: int_var_td_double = 460 INTEGER, PARAMETER :: int_var_td_integer = 480 INTEGER, PARAMETER :: int_var_td_logical = 500 INTEGER, PARAMETER :: int_var_td_char = 520 INTEGER, PARAMETER :: int_field = 530 INTEGER, PARAMETER :: int_var_info = 540 INTEGER, PARAMETER :: int_noop = 550 INTEGER, INTENT(INOUT) :: hdrbuf(*) INTEGER, INTENT(OUT) :: hdrbufsize INTEGER, INTENT(IN) :: itypesize, typesize CHARACTER*(*), INTENT(INOUT) :: Element REAL, INTENT(OUT) :: Data(*) INTEGER, INTENT(OUT) :: DataHandle, Count, code !Local INTEGER i, n ! CALL int_get_ti_header_c ( hdrbuf, hdrbufsize, n, itypesize, typesize, & DataHandle, Data, Count, code ) i = 1 CALL int_unpack_string ( Element, hdrbuf( n/itypesize + 1 ), n ) ; !write(0,*)'int_get_ti_header_real ',TRIM(Element), Data(1) hdrbufsize = hdrbuf(1) RETURN END SUBROUTINE int_get_ti_header_real !!!!!!!!!!!! SUBROUTINE int_gen_ti_header_char( hdrbuf, hdrbufsize, itypesize, & DataHandle, Element, VarName, Data, code ) ! !
! Items and their starting locations within a "time-independent string" 
! data header.  Assume that the data header is stored in integer vector 
! "hdrbuf":  
!  hdrbuf(1) = hdrbufsize
!  hdrbuf(2) = headerTag
!  hdrbuf(3) = DataHandle
!  hdrbuf(4) = typesize
!  hdrbuf(5) = LEN(TRIM(Element))
!  hdrbuf(6:5+n1) = Element                ! n1 = LEN(TRIM(Element)) + 1
!  hdrbuf(6+n1) = LEN(TRIM(Data))
!  hdrbuf(7+n1:6+n1+n2) = Data             ! n2 = LEN(TRIM(Data)) + 1
!  hdrbuf(7+n1+n2) = LEN(TRIM(VarName))
!  hdrbuf(8+n1+n2:7+n1+n2+n3) = VarName    ! n3 = LEN(TRIM(VarName)) + 1
!
! Further details for some items:  
!  hdrbufsize:  Size of this data header in bytes.  
!  headerTag:   "Header tag" that tells the I/O quilt servers what kind of 
!               header this is.  For an "time-independent string" header it must be 
!               set to int_dom_ti_char.  See file intio_tags.h for a complete 
!               list of these tags.  
!  DataHandle:  Descriptor for an open data set.  
!  typesize:    1 (size in bytes of a single CHARACTER).  
!  Element:     Name of the data.  
!  Data:        Data to write to file.  
!  VarName:     Variable name.  Used for *__var_ti_char but not for 
!               *__dom_ti_char.  
!  Other items are described in detail in the "WRF I/O and Model Coupling API 
!  Specification".  
!
!
!
IMPLICIT NONE INTEGER, PARAMETER :: int_ioexit = 10 INTEGER, PARAMETER :: int_open_for_write_begin = 20 INTEGER, PARAMETER :: int_open_for_write_commit = 30 INTEGER, PARAMETER :: int_open_for_read = 40 INTEGER, PARAMETER :: int_inquire_opened = 60 INTEGER, PARAMETER :: int_inquire_filename = 70 INTEGER, PARAMETER :: int_iosync = 80 INTEGER, PARAMETER :: int_ioclose = 90 INTEGER, PARAMETER :: int_next_time = 100 INTEGER, PARAMETER :: int_set_time = 110 INTEGER, PARAMETER :: int_next_var = 120 INTEGER, PARAMETER :: int_dom_ti_real = 140 INTEGER, PARAMETER :: int_dom_ti_double = 160 INTEGER, PARAMETER :: int_dom_ti_integer = 180 INTEGER, PARAMETER :: int_dom_ti_logical = 200 INTEGER, PARAMETER :: int_dom_ti_char = 220 INTEGER, PARAMETER :: int_dom_td_real = 240 INTEGER, PARAMETER :: int_dom_td_double = 260 INTEGER, PARAMETER :: int_dom_td_integer = 280 INTEGER, PARAMETER :: int_dom_td_logical = 300 INTEGER, PARAMETER :: int_dom_td_char = 320 INTEGER, PARAMETER :: int_var_ti_real = 340 INTEGER, PARAMETER :: int_var_ti_double = 360 INTEGER, PARAMETER :: int_var_ti_integer = 380 INTEGER, PARAMETER :: int_var_ti_logical = 400 INTEGER, PARAMETER :: int_var_ti_char = 420 INTEGER, PARAMETER :: int_var_td_real = 440 INTEGER, PARAMETER :: int_var_td_double = 460 INTEGER, PARAMETER :: int_var_td_integer = 480 INTEGER, PARAMETER :: int_var_td_logical = 500 INTEGER, PARAMETER :: int_var_td_char = 520 INTEGER, PARAMETER :: int_field = 530 INTEGER, PARAMETER :: int_var_info = 540 INTEGER, PARAMETER :: int_noop = 550 INTEGER, INTENT(INOUT) :: hdrbuf(*) INTEGER, INTENT(OUT) :: hdrbufsize INTEGER, INTENT(IN) :: itypesize CHARACTER*(*), INTENT(IN) :: Element, Data, VarName INTEGER, INTENT(IN) :: DataHandle, code !Local INTEGER :: DummyData INTEGER i, n, Count, DummyCount ! DummyCount = 0 CALL int_gen_ti_header_c ( hdrbuf, hdrbufsize, itypesize, 1, & DataHandle, DummyData, DummyCount, code ) i = hdrbufsize/itypesize+1 ; CALL int_pack_string ( Element, hdrbuf( i ), n ) ; i = i + n CALL int_pack_string ( Data , hdrbuf( i ), n ) ; i = i + n CALL int_pack_string ( VarName , hdrbuf( i ), n ) ; i = i + n hdrbufsize = (i-1) * itypesize + hdrbufsize ! return the number in bytes hdrbuf(1) = hdrbufsize RETURN END SUBROUTINE int_gen_ti_header_char SUBROUTINE int_get_ti_header_char( hdrbuf, hdrbufsize, itypesize, & DataHandle, Element, VarName, Data, code ) ! !
! Same as int_gen_ti_header_char except that Data is read from 
! the file.  
!
!
IMPLICIT NONE INTEGER, PARAMETER :: int_ioexit = 10 INTEGER, PARAMETER :: int_open_for_write_begin = 20 INTEGER, PARAMETER :: int_open_for_write_commit = 30 INTEGER, PARAMETER :: int_open_for_read = 40 INTEGER, PARAMETER :: int_inquire_opened = 60 INTEGER, PARAMETER :: int_inquire_filename = 70 INTEGER, PARAMETER :: int_iosync = 80 INTEGER, PARAMETER :: int_ioclose = 90 INTEGER, PARAMETER :: int_next_time = 100 INTEGER, PARAMETER :: int_set_time = 110 INTEGER, PARAMETER :: int_next_var = 120 INTEGER, PARAMETER :: int_dom_ti_real = 140 INTEGER, PARAMETER :: int_dom_ti_double = 160 INTEGER, PARAMETER :: int_dom_ti_integer = 180 INTEGER, PARAMETER :: int_dom_ti_logical = 200 INTEGER, PARAMETER :: int_dom_ti_char = 220 INTEGER, PARAMETER :: int_dom_td_real = 240 INTEGER, PARAMETER :: int_dom_td_double = 260 INTEGER, PARAMETER :: int_dom_td_integer = 280 INTEGER, PARAMETER :: int_dom_td_logical = 300 INTEGER, PARAMETER :: int_dom_td_char = 320 INTEGER, PARAMETER :: int_var_ti_real = 340 INTEGER, PARAMETER :: int_var_ti_double = 360 INTEGER, PARAMETER :: int_var_ti_integer = 380 INTEGER, PARAMETER :: int_var_ti_logical = 400 INTEGER, PARAMETER :: int_var_ti_char = 420 INTEGER, PARAMETER :: int_var_td_real = 440 INTEGER, PARAMETER :: int_var_td_double = 460 INTEGER, PARAMETER :: int_var_td_integer = 480 INTEGER, PARAMETER :: int_var_td_logical = 500 INTEGER, PARAMETER :: int_var_td_char = 520 INTEGER, PARAMETER :: int_field = 530 INTEGER, PARAMETER :: int_var_info = 540 INTEGER, PARAMETER :: int_noop = 550 INTEGER, INTENT(INOUT) :: hdrbuf(*) INTEGER, INTENT(OUT) :: hdrbufsize INTEGER, INTENT(IN) :: itypesize CHARACTER*(*), INTENT(INOUT) :: Element, Data, VarName INTEGER, INTENT(OUT) :: DataHandle, code !Local INTEGER i, n, DummyCount, typesize CHARACTER * 132 dummyData ! CALL int_get_ti_header_c ( hdrbuf, hdrbufsize, n, itypesize, typesize, & DataHandle, dummyData, DummyCount, code ) i = n/itypesize+1 ; CALL int_unpack_string ( Element, hdrbuf( i ), n ) ; i = i + n CALL int_unpack_string ( Data , hdrbuf( i ), n ) ; i = i + n CALL int_unpack_string ( VarName , hdrbuf( i ), n ) ; i = i + n hdrbufsize = hdrbuf(1) RETURN END SUBROUTINE int_get_ti_header_char !!!!!!!!!!!! SUBROUTINE int_gen_td_header_char( hdrbuf, hdrbufsize, itypesize, & DataHandle, DateStr, Element, Data, code ) ! !
! Items and their starting locations within a "time-dependent string" 
! data header.  Assume that the data header is stored in integer vector 
! "hdrbuf":  
!  hdrbuf(1) = hdrbufsize
!  hdrbuf(2) = headerTag
!  hdrbuf(3) = DataHandle
!  hdrbuf(4) = typesize
!  hdrbuf(5) = LEN(TRIM(Element))
!  hdrbuf(6:5+n1) = Element            ! n1 = LEN(TRIM(Element)) + 1
!  hdrbuf(6+n1) = LEN(TRIM(DateStr))
!  hdrbuf(7+n1:6+n1+n2) = DateStr      ! n2 = LEN(TRIM(DateStr)) + 1
!  hdrbuf(7+n1+n2) = LEN(TRIM(Data))
!  hdrbuf(8+n1+n2:7+n1+n2+n3) = Data   ! n3 = LEN(TRIM(Data)) + 1
!
! Further details for some items:  
!  hdrbufsize:  Size of this data header in bytes.  
!  headerTag:   "Header tag" that tells the I/O quilt servers what kind of 
!               header this is.  For an "time-dependent string" header it must be 
!               set to int_dom_td_char.  See file intio_tags.h for a complete 
!               list of these tags.  
!  DataHandle:  Descriptor for an open data set.  
!  typesize:    1 (size in bytes of a single CHARACTER).  
!  Element:     Name of the data.  
!  Data:        Data to write to file.  
!  Other items are described in detail in the "WRF I/O and Model Coupling API 
!  Specification".  
!
!
!
IMPLICIT NONE INTEGER, PARAMETER :: int_ioexit = 10 INTEGER, PARAMETER :: int_open_for_write_begin = 20 INTEGER, PARAMETER :: int_open_for_write_commit = 30 INTEGER, PARAMETER :: int_open_for_read = 40 INTEGER, PARAMETER :: int_inquire_opened = 60 INTEGER, PARAMETER :: int_inquire_filename = 70 INTEGER, PARAMETER :: int_iosync = 80 INTEGER, PARAMETER :: int_ioclose = 90 INTEGER, PARAMETER :: int_next_time = 100 INTEGER, PARAMETER :: int_set_time = 110 INTEGER, PARAMETER :: int_next_var = 120 INTEGER, PARAMETER :: int_dom_ti_real = 140 INTEGER, PARAMETER :: int_dom_ti_double = 160 INTEGER, PARAMETER :: int_dom_ti_integer = 180 INTEGER, PARAMETER :: int_dom_ti_logical = 200 INTEGER, PARAMETER :: int_dom_ti_char = 220 INTEGER, PARAMETER :: int_dom_td_real = 240 INTEGER, PARAMETER :: int_dom_td_double = 260 INTEGER, PARAMETER :: int_dom_td_integer = 280 INTEGER, PARAMETER :: int_dom_td_logical = 300 INTEGER, PARAMETER :: int_dom_td_char = 320 INTEGER, PARAMETER :: int_var_ti_real = 340 INTEGER, PARAMETER :: int_var_ti_double = 360 INTEGER, PARAMETER :: int_var_ti_integer = 380 INTEGER, PARAMETER :: int_var_ti_logical = 400 INTEGER, PARAMETER :: int_var_ti_char = 420 INTEGER, PARAMETER :: int_var_td_real = 440 INTEGER, PARAMETER :: int_var_td_double = 460 INTEGER, PARAMETER :: int_var_td_integer = 480 INTEGER, PARAMETER :: int_var_td_logical = 500 INTEGER, PARAMETER :: int_var_td_char = 520 INTEGER, PARAMETER :: int_field = 530 INTEGER, PARAMETER :: int_var_info = 540 INTEGER, PARAMETER :: int_noop = 550 INTEGER, INTENT(INOUT) :: hdrbuf(*) INTEGER, INTENT(OUT) :: hdrbufsize INTEGER, INTENT(IN) :: itypesize CHARACTER*(*), INTENT(INOUT) :: DateStr, Element, Data INTEGER, INTENT(IN) :: DataHandle, code !Local INTEGER i, n, DummyCount, DummyData ! DummyCount = 0 CALL int_gen_ti_header_c ( hdrbuf, hdrbufsize, itypesize, 1, & DataHandle, DummyData, DummyCount, code ) i = hdrbufsize/itypesize + 1 ; CALL int_pack_string ( Element, hdrbuf( i ), n ) ; i = i + n CALL int_pack_string ( DateStr, hdrbuf( i ), n ) ; i = i + n CALL int_pack_string ( Data , hdrbuf( i ), n ) ; i = i + n hdrbufsize = (i-1) * itypesize + hdrbufsize ! return the number in bytes hdrbuf(1) = hdrbufsize RETURN END SUBROUTINE int_gen_td_header_char SUBROUTINE int_get_td_header_char( hdrbuf, hdrbufsize, itypesize, & DataHandle, DateStr, Element, Data, code ) ! !
! Same as int_gen_td_header_char except that Data is read from 
! the file.  
!
!
IMPLICIT NONE INTEGER, PARAMETER :: int_ioexit = 10 INTEGER, PARAMETER :: int_open_for_write_begin = 20 INTEGER, PARAMETER :: int_open_for_write_commit = 30 INTEGER, PARAMETER :: int_open_for_read = 40 INTEGER, PARAMETER :: int_inquire_opened = 60 INTEGER, PARAMETER :: int_inquire_filename = 70 INTEGER, PARAMETER :: int_iosync = 80 INTEGER, PARAMETER :: int_ioclose = 90 INTEGER, PARAMETER :: int_next_time = 100 INTEGER, PARAMETER :: int_set_time = 110 INTEGER, PARAMETER :: int_next_var = 120 INTEGER, PARAMETER :: int_dom_ti_real = 140 INTEGER, PARAMETER :: int_dom_ti_double = 160 INTEGER, PARAMETER :: int_dom_ti_integer = 180 INTEGER, PARAMETER :: int_dom_ti_logical = 200 INTEGER, PARAMETER :: int_dom_ti_char = 220 INTEGER, PARAMETER :: int_dom_td_real = 240 INTEGER, PARAMETER :: int_dom_td_double = 260 INTEGER, PARAMETER :: int_dom_td_integer = 280 INTEGER, PARAMETER :: int_dom_td_logical = 300 INTEGER, PARAMETER :: int_dom_td_char = 320 INTEGER, PARAMETER :: int_var_ti_real = 340 INTEGER, PARAMETER :: int_var_ti_double = 360 INTEGER, PARAMETER :: int_var_ti_integer = 380 INTEGER, PARAMETER :: int_var_ti_logical = 400 INTEGER, PARAMETER :: int_var_ti_char = 420 INTEGER, PARAMETER :: int_var_td_real = 440 INTEGER, PARAMETER :: int_var_td_double = 460 INTEGER, PARAMETER :: int_var_td_integer = 480 INTEGER, PARAMETER :: int_var_td_logical = 500 INTEGER, PARAMETER :: int_var_td_char = 520 INTEGER, PARAMETER :: int_field = 530 INTEGER, PARAMETER :: int_var_info = 540 INTEGER, PARAMETER :: int_noop = 550 INTEGER, INTENT(INOUT) :: hdrbuf(*) INTEGER, INTENT(OUT) :: hdrbufsize INTEGER, INTENT(IN) :: itypesize CHARACTER*(*), INTENT(INOUT) :: DateStr, Element, Data INTEGER, INTENT(OUT) :: DataHandle, code !Local INTEGER i, n, Count, typesize ! CALL int_get_ti_header_c ( hdrbuf, hdrbufsize, n, itypesize, typesize, & DataHandle, Data, Count, code ) i = n/itypesize + 1 ; CALL int_unpack_string ( Element, hdrbuf( i ), n ) ; i = i + n ; CALL int_unpack_string ( DateStr, hdrbuf( i ), n ) ; i = i + n ; CALL int_unpack_string ( Data , hdrbuf( i ), n ) ; i = i + n ; hdrbufsize = hdrbuf(1) RETURN END SUBROUTINE int_get_td_header_char SUBROUTINE int_gen_td_header_integer( hdrbuf, hdrbufsize, itypesize, typesize, & DataHandle, DateStr, Element, Data, Count, code ) ! !
! Items and their starting locations within a "time-dependent integer" 
! data header.  Assume that the data header is stored in integer vector 
! "hdrbuf":  
!  hdrbuf(1) = hdrbufsize
!  hdrbuf(2) = headerTag
!  hdrbuf(3) = DataHandle
!  hdrbuf(4) = typesize
!  hdrbuf(5) = Count
!  hdrbuf(6:6+n1) = Data              ! n1 = (Count * typesize / itypesize) + 1
!  hdrbuf(7+n1) = LEN(TRIM(DateStr))
!  hdrbuf(8+n1:7+n1+n2) = DateStr      ! n2 = LEN(TRIM(DateStr)) + 1
!  hdrbuf(8+n1+n2) = LEN(TRIM(Element))
!  hdrbuf(9+n1+n2:8+n1+n2+n3) = Element   ! n3 = LEN(TRIM(Element)) + 1
!
! Further details for some items:  
!  hdrbufsize:  Size of this data header in bytes.  
!  headerTag:   "Header tag" that tells the I/O quilt servers what kind of 
!               header this is.  For an "time-dependent integer" header it must be 
!               set to int_dom_td_integer.  See file intio_tags.h for a complete 
!               list of these tags.  
!  DataHandle:  Descriptor for an open data set.  
!  typesize:    1 (size in bytes of a single CHARACTER).  
!  Element:     Name of the data.  
!  Count:       Number of elements in Data.  
!  Data:        Data to write to file.  
!  Other items are described in detail in the "WRF I/O and Model Coupling API 
!  Specification".  
!
!
!
IMPLICIT NONE INTEGER, PARAMETER :: int_ioexit = 10 INTEGER, PARAMETER :: int_open_for_write_begin = 20 INTEGER, PARAMETER :: int_open_for_write_commit = 30 INTEGER, PARAMETER :: int_open_for_read = 40 INTEGER, PARAMETER :: int_inquire_opened = 60 INTEGER, PARAMETER :: int_inquire_filename = 70 INTEGER, PARAMETER :: int_iosync = 80 INTEGER, PARAMETER :: int_ioclose = 90 INTEGER, PARAMETER :: int_next_time = 100 INTEGER, PARAMETER :: int_set_time = 110 INTEGER, PARAMETER :: int_next_var = 120 INTEGER, PARAMETER :: int_dom_ti_real = 140 INTEGER, PARAMETER :: int_dom_ti_double = 160 INTEGER, PARAMETER :: int_dom_ti_integer = 180 INTEGER, PARAMETER :: int_dom_ti_logical = 200 INTEGER, PARAMETER :: int_dom_ti_char = 220 INTEGER, PARAMETER :: int_dom_td_real = 240 INTEGER, PARAMETER :: int_dom_td_double = 260 INTEGER, PARAMETER :: int_dom_td_integer = 280 INTEGER, PARAMETER :: int_dom_td_logical = 300 INTEGER, PARAMETER :: int_dom_td_char = 320 INTEGER, PARAMETER :: int_var_ti_real = 340 INTEGER, PARAMETER :: int_var_ti_double = 360 INTEGER, PARAMETER :: int_var_ti_integer = 380 INTEGER, PARAMETER :: int_var_ti_logical = 400 INTEGER, PARAMETER :: int_var_ti_char = 420 INTEGER, PARAMETER :: int_var_td_real = 440 INTEGER, PARAMETER :: int_var_td_double = 460 INTEGER, PARAMETER :: int_var_td_integer = 480 INTEGER, PARAMETER :: int_var_td_logical = 500 INTEGER, PARAMETER :: int_var_td_char = 520 INTEGER, PARAMETER :: int_field = 530 INTEGER, PARAMETER :: int_var_info = 540 INTEGER, PARAMETER :: int_noop = 550 INTEGER, INTENT(INOUT) :: hdrbuf(*) INTEGER, INTENT(OUT) :: hdrbufsize INTEGER, INTENT(IN) :: itypesize, typesize CHARACTER*(*), INTENT(INOUT) :: DateStr, Element INTEGER, INTENT(IN) :: Data(*) INTEGER, INTENT(IN) :: DataHandle, Count, code !Local INTEGER i, n ! CALL int_gen_ti_header_c ( hdrbuf, hdrbufsize, itypesize, typesize, & DataHandle, Data, Count, code ) i = hdrbufsize/itypesize + 1 ; CALL int_pack_string ( DateStr, hdrbuf( i ), n ) ; i = i + n CALL int_pack_string ( Element, hdrbuf( i ), n ) ; i = i + n hdrbufsize = (i-1) * itypesize + hdrbufsize ! return the number in bytes hdrbuf(1) = hdrbufsize RETURN END SUBROUTINE int_gen_td_header_integer SUBROUTINE int_gen_td_header_real( hdrbuf, hdrbufsize, itypesize, typesize, & DataHandle, DateStr, Element, Data, Count, code ) ! !
! Same as int_gen_td_header_integer except that Data has type REAL.  
!
!
IMPLICIT NONE INTEGER, PARAMETER :: int_ioexit = 10 INTEGER, PARAMETER :: int_open_for_write_begin = 20 INTEGER, PARAMETER :: int_open_for_write_commit = 30 INTEGER, PARAMETER :: int_open_for_read = 40 INTEGER, PARAMETER :: int_inquire_opened = 60 INTEGER, PARAMETER :: int_inquire_filename = 70 INTEGER, PARAMETER :: int_iosync = 80 INTEGER, PARAMETER :: int_ioclose = 90 INTEGER, PARAMETER :: int_next_time = 100 INTEGER, PARAMETER :: int_set_time = 110 INTEGER, PARAMETER :: int_next_var = 120 INTEGER, PARAMETER :: int_dom_ti_real = 140 INTEGER, PARAMETER :: int_dom_ti_double = 160 INTEGER, PARAMETER :: int_dom_ti_integer = 180 INTEGER, PARAMETER :: int_dom_ti_logical = 200 INTEGER, PARAMETER :: int_dom_ti_char = 220 INTEGER, PARAMETER :: int_dom_td_real = 240 INTEGER, PARAMETER :: int_dom_td_double = 260 INTEGER, PARAMETER :: int_dom_td_integer = 280 INTEGER, PARAMETER :: int_dom_td_logical = 300 INTEGER, PARAMETER :: int_dom_td_char = 320 INTEGER, PARAMETER :: int_var_ti_real = 340 INTEGER, PARAMETER :: int_var_ti_double = 360 INTEGER, PARAMETER :: int_var_ti_integer = 380 INTEGER, PARAMETER :: int_var_ti_logical = 400 INTEGER, PARAMETER :: int_var_ti_char = 420 INTEGER, PARAMETER :: int_var_td_real = 440 INTEGER, PARAMETER :: int_var_td_double = 460 INTEGER, PARAMETER :: int_var_td_integer = 480 INTEGER, PARAMETER :: int_var_td_logical = 500 INTEGER, PARAMETER :: int_var_td_char = 520 INTEGER, PARAMETER :: int_field = 530 INTEGER, PARAMETER :: int_var_info = 540 INTEGER, PARAMETER :: int_noop = 550 INTEGER, INTENT(INOUT) :: hdrbuf(*) INTEGER, INTENT(OUT) :: hdrbufsize INTEGER, INTENT(IN) :: itypesize, typesize CHARACTER*(*), INTENT(INOUT) :: DateStr, Element REAL, INTENT(IN) :: Data(*) INTEGER, INTENT(IN) :: DataHandle, Count, code !Local INTEGER i, n ! CALL int_gen_ti_header_c ( hdrbuf, hdrbufsize, itypesize, typesize, & DataHandle, Data, Count, code ) i = hdrbufsize/itypesize + 1 ; CALL int_pack_string ( DateStr, hdrbuf( i ), n ) ; i = i + n CALL int_pack_string ( Element, hdrbuf( i ), n ) ; i = i + n hdrbufsize = (i-1) * itypesize + hdrbufsize ! return the number in bytes hdrbuf(1) = hdrbufsize RETURN END SUBROUTINE int_gen_td_header_real SUBROUTINE int_get_td_header_integer( hdrbuf, hdrbufsize, itypesize, typesize, & DataHandle, DateStr, Element, Data, Count, code ) ! !
! Same as int_gen_td_header_integer except that Data is read from 
! the file.  
!
!
IMPLICIT NONE INTEGER, PARAMETER :: int_ioexit = 10 INTEGER, PARAMETER :: int_open_for_write_begin = 20 INTEGER, PARAMETER :: int_open_for_write_commit = 30 INTEGER, PARAMETER :: int_open_for_read = 40 INTEGER, PARAMETER :: int_inquire_opened = 60 INTEGER, PARAMETER :: int_inquire_filename = 70 INTEGER, PARAMETER :: int_iosync = 80 INTEGER, PARAMETER :: int_ioclose = 90 INTEGER, PARAMETER :: int_next_time = 100 INTEGER, PARAMETER :: int_set_time = 110 INTEGER, PARAMETER :: int_next_var = 120 INTEGER, PARAMETER :: int_dom_ti_real = 140 INTEGER, PARAMETER :: int_dom_ti_double = 160 INTEGER, PARAMETER :: int_dom_ti_integer = 180 INTEGER, PARAMETER :: int_dom_ti_logical = 200 INTEGER, PARAMETER :: int_dom_ti_char = 220 INTEGER, PARAMETER :: int_dom_td_real = 240 INTEGER, PARAMETER :: int_dom_td_double = 260 INTEGER, PARAMETER :: int_dom_td_integer = 280 INTEGER, PARAMETER :: int_dom_td_logical = 300 INTEGER, PARAMETER :: int_dom_td_char = 320 INTEGER, PARAMETER :: int_var_ti_real = 340 INTEGER, PARAMETER :: int_var_ti_double = 360 INTEGER, PARAMETER :: int_var_ti_integer = 380 INTEGER, PARAMETER :: int_var_ti_logical = 400 INTEGER, PARAMETER :: int_var_ti_char = 420 INTEGER, PARAMETER :: int_var_td_real = 440 INTEGER, PARAMETER :: int_var_td_double = 460 INTEGER, PARAMETER :: int_var_td_integer = 480 INTEGER, PARAMETER :: int_var_td_logical = 500 INTEGER, PARAMETER :: int_var_td_char = 520 INTEGER, PARAMETER :: int_field = 530 INTEGER, PARAMETER :: int_var_info = 540 INTEGER, PARAMETER :: int_noop = 550 INTEGER, INTENT(INOUT) :: hdrbuf(*) INTEGER, INTENT(OUT) :: hdrbufsize INTEGER, INTENT(IN) :: itypesize, typesize CHARACTER*(*), INTENT(INOUT) :: DateStr, Element INTEGER, INTENT(OUT) :: Data(*) INTEGER, INTENT(OUT) :: DataHandle, Count, code !Local INTEGER i, n ! CALL int_get_ti_header_c ( hdrbuf, hdrbufsize, n, itypesize, typesize, & DataHandle, Data, Count, code ) i = n/itypesize + 1 ; CALL int_unpack_string ( DateStr, hdrbuf( i ), n ) ; i = i + n ; CALL int_unpack_string ( Element, hdrbuf( i ), n ) ; i = i + n ; hdrbufsize = hdrbuf(1) RETURN END SUBROUTINE int_get_td_header_integer SUBROUTINE int_get_td_header_real( hdrbuf, hdrbufsize, itypesize, typesize, & DataHandle, DateStr, Element, Data, Count, code ) ! !
! Same as int_gen_td_header_real except that Data is read from 
! the file.  
!
!
IMPLICIT NONE INTEGER, PARAMETER :: int_ioexit = 10 INTEGER, PARAMETER :: int_open_for_write_begin = 20 INTEGER, PARAMETER :: int_open_for_write_commit = 30 INTEGER, PARAMETER :: int_open_for_read = 40 INTEGER, PARAMETER :: int_inquire_opened = 60 INTEGER, PARAMETER :: int_inquire_filename = 70 INTEGER, PARAMETER :: int_iosync = 80 INTEGER, PARAMETER :: int_ioclose = 90 INTEGER, PARAMETER :: int_next_time = 100 INTEGER, PARAMETER :: int_set_time = 110 INTEGER, PARAMETER :: int_next_var = 120 INTEGER, PARAMETER :: int_dom_ti_real = 140 INTEGER, PARAMETER :: int_dom_ti_double = 160 INTEGER, PARAMETER :: int_dom_ti_integer = 180 INTEGER, PARAMETER :: int_dom_ti_logical = 200 INTEGER, PARAMETER :: int_dom_ti_char = 220 INTEGER, PARAMETER :: int_dom_td_real = 240 INTEGER, PARAMETER :: int_dom_td_double = 260 INTEGER, PARAMETER :: int_dom_td_integer = 280 INTEGER, PARAMETER :: int_dom_td_logical = 300 INTEGER, PARAMETER :: int_dom_td_char = 320 INTEGER, PARAMETER :: int_var_ti_real = 340 INTEGER, PARAMETER :: int_var_ti_double = 360 INTEGER, PARAMETER :: int_var_ti_integer = 380 INTEGER, PARAMETER :: int_var_ti_logical = 400 INTEGER, PARAMETER :: int_var_ti_char = 420 INTEGER, PARAMETER :: int_var_td_real = 440 INTEGER, PARAMETER :: int_var_td_double = 460 INTEGER, PARAMETER :: int_var_td_integer = 480 INTEGER, PARAMETER :: int_var_td_logical = 500 INTEGER, PARAMETER :: int_var_td_char = 520 INTEGER, PARAMETER :: int_field = 530 INTEGER, PARAMETER :: int_var_info = 540 INTEGER, PARAMETER :: int_noop = 550 INTEGER, INTENT(INOUT) :: hdrbuf(*) INTEGER, INTENT(OUT) :: hdrbufsize INTEGER, INTENT(IN) :: itypesize, typesize CHARACTER*(*), INTENT(INOUT) :: DateStr, Element REAL , INTENT(OUT) :: Data(*) INTEGER, INTENT(OUT) :: DataHandle, Count, code !Local INTEGER i, n ! CALL int_get_ti_header_c ( hdrbuf, hdrbufsize, n, itypesize, typesize, & DataHandle, Data, Count, code ) i = n/itypesize + 1 ; CALL int_unpack_string ( DateStr, hdrbuf( i ), n ) ; i = i + n ; CALL int_unpack_string ( Element, hdrbuf( i ), n ) ; i = i + n ; hdrbufsize = hdrbuf(1) RETURN END SUBROUTINE int_get_td_header_real !!!!!!!!!!!!!! SUBROUTINE int_gen_noop_header ( hdrbuf, hdrbufsize, itypesize ) IMPLICIT NONE ! !
! Items and their starting locations within a "no-operation" 
! data header.  Assume that the data header is stored in integer vector 
! "hdrbuf":  
!  hdrbuf(1) = hdrbufsize
!  hdrbuf(2) = headerTag
!
! Further details for some items:  
!  hdrbufsize:  Size of this data header in bytes.  
!  headerTag:   "Header tag" that tells the I/O quilt servers what kind of 
!               header this is.  For an "no-operation" header it must be 
!               set to int_noop.  See file intio_tags.h for a complete 
!               list of these tags.  
!
!
!
INTEGER, PARAMETER :: int_ioexit = 10 INTEGER, PARAMETER :: int_open_for_write_begin = 20 INTEGER, PARAMETER :: int_open_for_write_commit = 30 INTEGER, PARAMETER :: int_open_for_read = 40 INTEGER, PARAMETER :: int_inquire_opened = 60 INTEGER, PARAMETER :: int_inquire_filename = 70 INTEGER, PARAMETER :: int_iosync = 80 INTEGER, PARAMETER :: int_ioclose = 90 INTEGER, PARAMETER :: int_next_time = 100 INTEGER, PARAMETER :: int_set_time = 110 INTEGER, PARAMETER :: int_next_var = 120 INTEGER, PARAMETER :: int_dom_ti_real = 140 INTEGER, PARAMETER :: int_dom_ti_double = 160 INTEGER, PARAMETER :: int_dom_ti_integer = 180 INTEGER, PARAMETER :: int_dom_ti_logical = 200 INTEGER, PARAMETER :: int_dom_ti_char = 220 INTEGER, PARAMETER :: int_dom_td_real = 240 INTEGER, PARAMETER :: int_dom_td_double = 260 INTEGER, PARAMETER :: int_dom_td_integer = 280 INTEGER, PARAMETER :: int_dom_td_logical = 300 INTEGER, PARAMETER :: int_dom_td_char = 320 INTEGER, PARAMETER :: int_var_ti_real = 340 INTEGER, PARAMETER :: int_var_ti_double = 360 INTEGER, PARAMETER :: int_var_ti_integer = 380 INTEGER, PARAMETER :: int_var_ti_logical = 400 INTEGER, PARAMETER :: int_var_ti_char = 420 INTEGER, PARAMETER :: int_var_td_real = 440 INTEGER, PARAMETER :: int_var_td_double = 460 INTEGER, PARAMETER :: int_var_td_integer = 480 INTEGER, PARAMETER :: int_var_td_logical = 500 INTEGER, PARAMETER :: int_var_td_char = 520 INTEGER, PARAMETER :: int_field = 530 INTEGER, PARAMETER :: int_var_info = 540 INTEGER, PARAMETER :: int_noop = 550 INTEGER, INTENT(INOUT) :: hdrbuf(*) INTEGER, INTENT(OUT) :: hdrbufsize INTEGER, INTENT(INOUT) :: itypesize !Local INTEGER i ! hdrbuf(1) = 0 !deferred hdrbuf(2) = int_noop i = 3 hdrbufsize = (i-1) * itypesize ! return the number in bytes hdrbuf(1) = hdrbufsize RETURN END SUBROUTINE int_gen_noop_header SUBROUTINE int_get_noop_header( hdrbuf, hdrbufsize, itypesize ) ! !
! See documentation block in int_gen_noop_header() for 
! a description of a "no-operation" header.  
!
!
IMPLICIT NONE INTEGER, PARAMETER :: int_ioexit = 10 INTEGER, PARAMETER :: int_open_for_write_begin = 20 INTEGER, PARAMETER :: int_open_for_write_commit = 30 INTEGER, PARAMETER :: int_open_for_read = 40 INTEGER, PARAMETER :: int_inquire_opened = 60 INTEGER, PARAMETER :: int_inquire_filename = 70 INTEGER, PARAMETER :: int_iosync = 80 INTEGER, PARAMETER :: int_ioclose = 90 INTEGER, PARAMETER :: int_next_time = 100 INTEGER, PARAMETER :: int_set_time = 110 INTEGER, PARAMETER :: int_next_var = 120 INTEGER, PARAMETER :: int_dom_ti_real = 140 INTEGER, PARAMETER :: int_dom_ti_double = 160 INTEGER, PARAMETER :: int_dom_ti_integer = 180 INTEGER, PARAMETER :: int_dom_ti_logical = 200 INTEGER, PARAMETER :: int_dom_ti_char = 220 INTEGER, PARAMETER :: int_dom_td_real = 240 INTEGER, PARAMETER :: int_dom_td_double = 260 INTEGER, PARAMETER :: int_dom_td_integer = 280 INTEGER, PARAMETER :: int_dom_td_logical = 300 INTEGER, PARAMETER :: int_dom_td_char = 320 INTEGER, PARAMETER :: int_var_ti_real = 340 INTEGER, PARAMETER :: int_var_ti_double = 360 INTEGER, PARAMETER :: int_var_ti_integer = 380 INTEGER, PARAMETER :: int_var_ti_logical = 400 INTEGER, PARAMETER :: int_var_ti_char = 420 INTEGER, PARAMETER :: int_var_td_real = 440 INTEGER, PARAMETER :: int_var_td_double = 460 INTEGER, PARAMETER :: int_var_td_integer = 480 INTEGER, PARAMETER :: int_var_td_logical = 500 INTEGER, PARAMETER :: int_var_td_char = 520 INTEGER, PARAMETER :: int_field = 530 INTEGER, PARAMETER :: int_var_info = 540 INTEGER, PARAMETER :: int_noop = 550 INTEGER, INTENT(INOUT) :: hdrbuf(*) INTEGER, INTENT(OUT) :: hdrbufsize INTEGER, INTENT(INOUT) :: itypesize !Local INTEGER i ! hdrbufsize = hdrbuf(1) IF ( hdrbuf(2) .NE. int_noop ) THEN CALL wrf_error_fatal ( "int_get_noop_header: hdrbuf ne int_noop") ENDIF i = 3 RETURN END SUBROUTINE int_get_noop_header ! first int is length of string to follow then string encodes as ints SUBROUTINE int_pack_string ( str, buf, n ) IMPLICIT NONE ! !
! This routine is used to store a string as a sequence of integers.  
! The first integer is the string length.  
!
!
CHARACTER*(*), INTENT(IN) :: str INTEGER, INTENT(OUT) :: n ! on return, N is the number of ints stored in buf INTEGER, INTENT(OUT), DIMENSION(*) :: buf !Local INTEGER i ! n = 1 buf(n) = LEN(TRIM(str)) n = n+1 DO i = 1, LEN(TRIM(str)) buf(n) = ichar(str(i:i)) n = n+1 ENDDO n = n - 1 END SUBROUTINE int_pack_string SUBROUTINE int_unpack_string ( str, buf, n ) IMPLICIT NONE ! !
! This routine is used to extract a string from a sequence of integers.  
! The first integer is the string length.  
!
!
CHARACTER*(*), INTENT(OUT) :: str INTEGER, INTENT(OUT) :: n ! on return, N is the number of ints copied from buf INTEGER, INTENT(IN), DIMENSION(*) :: buf !Local INTEGER i INTEGER strlen strlen = buf(1) str = "" DO i = 1, strlen str(i:i) = char(buf(i+1)) ENDDO n = strlen + 1 END SUBROUTINE int_unpack_string END MODULE module_internal_header_util