external/io_int/module_io_int_idx.F90

   1 #if defined ( NO_ISO_C_SUPPORT )
   2 module module_io_int_idx
   3    private
   4    contains
   5       subroutine dummy
   6       end subroutine dummy
   7 end module module_io_int_idx
   8
   9 #else
  10 !
  11 ! Public domain.
  12 !
  13
  14 !>
  15 !! Module to retrieve an index from a WRF I/O Internal format file.
  16 !!
  17 !! This module is a binding to the C routines to perform the
  18 !! index generation.
  19 !!
  20 !! The index generation will only parse records that have a size
  21 !! of 2048 bytes. The index will consist of:
  22 !! - offset The absolute offset to the start of the record within the file.
  23 !! - data_offset The offset to the start of the data section.
  24 !! - data_count  The number of data entries.
  25 !! - data_type   The WRF type of the data entry.
  26 !! - name   The record name.
  27 !! - date   The date if the record is time dependent.
  28 !
  29 !
  30 module module_io_int_idx
  31
  32     use, intrinsic :: iso_c_binding,                                    &
  33                       only: c_char, c_ptr, c_int32_t, c_int64_t, c_loc, &
  34                             c_null_char, c_null_ptr, c_f_pointer
  35
  36     implicit none
  37     private
  38     public :: r_info, io_int_index, io_int_loc, io_int_string
  39
  40     integer, parameter :: F_LEN   = 2048
  41     integer, parameter :: STR_LEN = 132
  42
  43     integer, parameter :: int_t    = selected_int_kind(8)   ! int32_t
  44     integer, parameter :: llong_t  = selected_int_kind(16)  ! int64_t
  45     integer, parameter :: float_t  = selected_real_kind(6)  ! float
  46     integer, parameter :: double_t = selected_real_kind(15) ! double
  47
  48     !>
  49     !! r_info type definition for passing records meta data
  50     !! to and from C.
  51     !! The meta data consists of
  52     !! - offset The absolute offset to the start of the record within the file.
  53     !! - data_offset The offset to the start of the data section.
  54     !! - data_count  The number of data entries.
  55     !! - data_type   The WRF type of the data entry.
  56     !! - name   The record name.
  57     !! - date   The date if the record is time dependent.
  58     type, bind(c) :: r_info
  59         integer(c_int64_t)                         :: offset
  60         integer(c_int64_t)                         :: data_offset
  61         integer(c_int32_t)                         :: data_count
  62         integer(c_int32_t)                         :: data_type
  63         character(kind=c_char), dimension(STR_LEN) :: name
  64         character(kind=c_char), dimension(STR_LEN) :: date
  65     end type r_info
  66
  67     !> All the interfaces are to the C functions. They all have
  68     !! suffixes _c to indicate this.
  69     interface
  70
  71         integer(c_int32_t)                                        &
  72         function io_int_index_c                                   &
  73                    (filename, records, nrecords)                  &
  74                    bind(c, name='io_int_index')
  75             import :: c_ptr, c_char, c_int32_t, c_int64_t
  76             character(kind=c_char), dimension(*), intent(in)    :: filename
  77             type(c_ptr),                          intent(out)   :: records
  78             integer(c_int32_t),                   intent(out)   :: nrecords
  79         end function io_int_index_c
  80
  81         integer(c_int32_t)                                        &
  82         function io_int_loc_c                                     &
  83                    (record, records, n, offset, count)            &
  84                    bind(c, name='io_int_loc')
  85             import :: c_ptr, c_char, c_int32_t, c_int64_t, r_info
  86             character(kind=c_char), dimension(*), intent(in)    :: record
  87             integer(c_int32_t), value,            intent(in)    :: n
  88             type(r_info),                         intent(in)    :: records(n)
  89             integer(c_int64_t),                   intent(out)   :: offset
  90             integer(c_int32_t),                   intent(out)   :: count
  91         end function io_int_loc_c
  92
  93     end interface
  94
  95     contains
  96
  97     !>
  98     !! io_int_index generates an index of record names and
  99     !! offsets in a WRF IO binary file.
 100     !!
 101     !! There is a one-to-one mapping of offsets and record names.
 102     !! That is offset(i) corresponds to name(1), etc.
 103     !!
 104     !! \param[in]  filename The filename of binary file.
 105     !! \param[out] records  A struct of r_info record information.
 106     !! \param[out] nrecords The number of records within the file.
 107     !! \param[out] ierr     Return error status,
 108     !!                      0 If it was sucessful.
 109     !!                      1 If there was any error.
 110     !
 111     subroutine io_int_index(filename, records, ierr)
 112         implicit none
 113
 114         character(len=*),      intent(in)  :: filename
 115         type(r_info), pointer, intent(out) :: records(:)
 116         integer,               intent(out) :: ierr
 117
 118         type(c_ptr)                        :: r          ! Pointer to records
 119         integer                            :: nrecords   ! Number of records
 120         character(len=1024)                :: message    ! Error string
 121
 122         nrecords = 0 ! Set the number of records to zero
 123         ierr     = 0 ! Clear the error status
 124
 125         ierr = io_int_index_c(trim(filename)//c_null_char, r, nrecords)
 126         if (ierr .ne. 0) then
 127             write(message, *) 'Unable to index WRF binary file'
 128             call wrf_message(message)
 129             return
 130         endif
 131         call c_f_pointer(r, records, [nrecords])
 132
 133     end subroutine io_int_index
 134
 135     !>
 136     !! io_int_loc locates a record in the index of records,
 137     !! returning the record offset and element count.
 138     !!
 139     !! \param[in]  record  The record name to lookup.
 140     !! \param[in]  records A list of records information.
 141     !! \param[out] offset  The data start offset in the file.
 142     !! \param[out] count   The number of elements in the data.
 143     !! \param[out] ierr     Return error status,
 144     !!                      0 If it was sucessful.
 145     !!                      1 If there was any error.
 146     !
 147     subroutine io_int_loc(record, records, offset, count, ierr)
 148         implicit none
 149
 150         character(len=*),         intent(in)  :: record
 151         type(r_info),             intent(in)  :: records(:)
 152         integer(kind=llong_t),    intent(out) :: offset
 153         integer,                  intent(out) :: count
 154         integer,                  intent(out) :: ierr
 155
 156         character(len=1024)                   :: message    ! Error string
 157
 158         ierr   = 0 ! Clear the error status
 159         offset = 0 ! Set the offset to zero
 160         count  = 0 ! Set the count to zero
 161
 162         ierr = io_int_loc_c(trim(record)//c_null_char, records, &
 163                                 size(records),  offset, count)
 164         if (ierr .ne. 0) then
 165             write(message, *) 'Unable find ', trim(record)
 166             call wrf_message(message)
 167             return
 168         endif
 169
 170     end subroutine io_int_loc
 171
 172     !>
 173     !! io_int_string converts an array of characters into a
 174     !! string.
 175     !!
 176     !! This function is needed due to some fortran compliers not
 177     !! working well when the C binding returns a character array
 178     !! and interpreting it as a string.
 179     !!
 180     !! \param[in]  arr The character array.
 181     !! \returns    str The fortran string.
 182     !
 183     function io_int_string(arr) result(str)
 184         character(kind=c_char),               intent(in)  :: arr(STR_LEN)
 185         character(len=STR_LEN)                            :: str
 186
 187         integer                            :: i ! Temporary loop indexer
 188
 189         i = 1
 190         do i=1,STR_LEN
 191             str(i:i)   = arr(i)
 192         enddo
 193
 194     end function io_int_string
 195
 196 end module module_io_int_idx
 197 #endif