FMS  2024.03
Flexible Modeling System
mpp_read_distributed_ascii.inc
1 !***********************************************************************
2 !* GNU Lesser General Public License
3 !*
4 !* This file is part of the GFDL Flexible Modeling System (FMS).
5 !*
6 !* FMS is free software: you can redistribute it and/or modify it under
7 !* the terms of the GNU Lesser General Public License as published by
8 !* the Free Software Foundation, either version 3 of the License, or (at
9 !* your option) any later version.
10 !*
11 !* FMS is distributed in the hope that it will be useful, but WITHOUT
12 !* ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13 !* FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
14 !* for more details.
15 !*
16 !* You should have received a copy of the GNU Lesser General Public
17 !* License along with FMS. If not, see <http://www.gnu.org/licenses/>.
18 !***********************************************************************
19 
20 !> @file
21 !> @brief Routines for reading distributed ascii files for @ref mpp_io_mod
22 
23 !> @addtogroup mpp_io_mod
24 !> @{
25 
26 #undef MPP_READ_DISTRIBUTED_ASCII_1D_
27 #define MPP_READ_DISTRIBUTED_ASCII_1D_ mpp_read_distributed_ascii_r1D
28 #undef MPP_TYPE_
29 #define MPP_TYPE_ real
30 #include <mpp_read_distributed_ascii.fh>
31 
32 #undef MPP_READ_DISTRIBUTED_ASCII_1D_
33 #define MPP_READ_DISTRIBUTED_ASCII_1D_ mpp_read_distributed_ascii_i1D
34 #undef MPP_TYPE_
35 #define MPP_TYPE_ integer
36 #include <mpp_read_distributed_ascii.fh>
37 
38 subroutine mpp_read_distributed_ascii_a1d(unit,fmt,ssize,data,iostat)
39  integer, intent(in) :: unit
40  character(*), intent(in) :: fmt
41  integer, intent(in) :: ssize
42  character(len=*), dimension(:), intent(inout) :: data
43  integer, intent(out) :: iostat
44 
45  integer, allocatable :: pelist(:)
46  logical :: is_ioroot=.false.
47 
48 
49  if(.not.module_is_initialized) call mpp_error(fatal,'mpp_read_distributed_ascii_a1D: module not initialized')
50 
51  iostat = 0
52  call mpp_dist_io_pelist(ssize,pelist)
53  if(.not. ALLOCATED(pelist)) &
54  call mpp_error(fatal,'mpp_read_distributed_ascii_a1D: pelist allocation failed')
55  is_ioroot = mpp_is_dist_ioroot(ssize)
56  if(is_ioroot) then
57  if(trim(fmt)=='*')then
58  read(unit,*,iostat=iostat) data
59  else
60  read(unit,fmt=trim(fmt),iostat=iostat) data
61  endif
62  if(iostat /= 0) return ! Calling routine must handle error
63  endif
64 
65  call mpp_broadcast(data,len(data(1)),pelist(1),pelist)
66  deallocate(pelist) ! Don't forget to deallocate pelist
67 end subroutine mpp_read_distributed_ascii_a1d
68 !> @}