FMS 2025.01-dev
Flexible Modeling System
Loading...
Searching...
No Matches
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
38subroutine 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
67end subroutine mpp_read_distributed_ascii_a1d
68!> @}