external/io_int/test_io_mpi.f90

   1 !
   2 ! Public domain.
   3 !
   4
   5 program test_io_mpi
   6
   7     use module_io_int_idx, only: io_int_index, r_info
   8     use module_io_int_read, only: io_int_fetch_data
   9     use mpi
  10
  11     implicit none
  12
  13     integer, parameter :: llong_t   = selected_int_kind(16)   ! int64_t
  14
  15     integer                            :: argc
  16     integer                            :: ierr
  17     integer                            :: i
  18     integer                            :: iunit
  19     integer(kind=llong_t)              :: offset
  20     integer                            :: count
  21     character(len=256)                 :: filename
  22     type(r_info), pointer              :: records(:) => NULL()
  23     integer                            :: nrecords
  24     character(len=256)                 :: var
  25     character(len=256)                 :: value
  26
  27     argc     = 0
  28     filename = ''
  29     ierr     = 0
  30     offset   = 0
  31     count    = 0
  32     nrecords = 0
  33     var      = ''
  34     value    = ''
  35
  36     call mpi_init(ierr)
  37
  38     ! Get the file name to index
  39     argc = iargc()
  40     if (argc .lt. 2 ) then
  41         write(0, *) 'Must supply a filename to index and a variable to get.'
  42         write(0, *) 'i.e.: test_io_mpi MMINLU'
  43         call exit(1)
  44     endif
  45     call getarg(1, filename)
  46     call getarg(2, var)
  47
  48     call io_int_index(filename, records, ierr)
  49     if (ierr .ne. 0) then
  50         call exit(ierr)
  51     endif
  52
  53     call mpi_file_open(mpi_comm_world, trim(filename), &
  54                        mpi_mode_rdonly, mpi_info_null, &
  55                        iunit, ierr)
  56
  57     call io_int_fetch_data(iunit, records, trim(var), value, ierr)
  58     write(6,*) trim(var), ': ', trim(value)
  59
  60     call mpi_file_close(iunit, ierr)
  61     call mpi_finalize(ierr)
  62
  63 end program test_io_mpi
  64
  65 !
  66 subroutine wrf_message(message)
  67
  68     implicit none
  69
  70     character(len=*), intent(in) :: message
  71
  72     write(0,*) trim(message)
  73 end subroutine wrf_message
  74
  75 subroutine wrf_error_fatal3(file, line, message)
  76
  77     implicit none
  78
  79     character(len=*), intent(in) :: file
  80     integer,          intent(in) :: line
  81     character(len=*), intent(in) :: message
  82
  83     write(0,*) trim(file), 'line: ', line, ': ', trim(message)
  84     stop(1)
  85 end subroutine wrf_error_fatal3