File: C:\NOAA\NEMS_11731\src\chem\gocart\src\GMAO_Shared\MAPL_Base\read_parallel.H
1 ! $Id: read_parallel.H,v 1.5 2009/04/29 16:01:51 wputman Exp $
2
3 #ifdef NAME_
4 #undef NAME_
5 #endif
6
7 #define NAME_ READ_PARALLEL_
8
9 #include "overload.macro"
10
11 subroutine SUB_ ( layout, DATA, UNIT, FORMAT, arrdes, RC)
12
13 type (ESMF_DELayout) :: layout
14 #if (VARTYPE_ > 0)
15 TYPE_(kind=EKIND_), intent( OUT) :: data DIMENSIONS_
16 #else
17 character(LEN=*), intent( OUT) :: data DIMENSIONS_
18 #endif
19 integer, intent(in ), optional :: UNIT
20 character(len=*), intent(in ), optional :: FORMAT
21 type(ArrDescr), optional, intent(INOUT ) :: ARRDES
22 integer , intent( out), optional :: RC
23
24 character(len=ESMF_MAXSTR) :: FORMATTED
25 character(LEN=ESMF_MAXSTR) :: FILENAME
26 logical :: IS_NAMED
27 integer :: USABLE_UNIT
28 integer :: IOSTAT
29 integer :: status
30 character(len=ESMF_MAXSTR) :: IAM='READ_PARALLEL'
31 #if (RANK_ == 1 && VARTYPE_ == 4)
32 integer :: nretries
33 #endif
34
35 if(present(arrdes)) then
36 if (MAPL_AM_I_ROOT(layout)) then
37 if(arrdes%offset>0) then
38 call MPI_FILE_SEEK(UNIT, arrdes%offset, MPI_SEEK_SET, STATUS)
39 VERIFY_(STATUS)
40 endif
41
42 #if (RANK_ == 0)
43 #if (VARTYPE_ == 0)
44 call MPI_FILE_READ(UNIT, data, len(data), MPITYPE_, MPI_STATUS_IGNORE, STATUS)
45 #else
46 call MPI_FILE_READ(UNIT, data, 1, MPITYPE_, MPI_STATUS_IGNORE, STATUS)
47 #endif
48 #else
49 call MPI_FILE_READ(UNIT, data, size(data), MPITYPE_, MPI_STATUS_IGNORE, STATUS)
50 #endif
51 VERIFY_(STATUS)
52 endif
53
54 #if (RANK_ == 0)
55 #if (VARTYPE_ == 0)
56 call MAPL_CommsBcast(layout, data, len(data), MAPL_Root, status)
57 #else
58 call MAPL_CommsBcast(layout, data, 1, MAPL_Root, status)
59 #endif
60 #else
61 call MAPL_CommsBcast(layout, data, size(data), MAPL_Root, status)
62 #endif
63 VERIFY_(status)
64
65 #if (RANK_ == 0)
66 #if (VARTYPE_ == 0)
67 arrdes%offset = arrdes%offset + len(data)*4 + 8
68 #else
69 arrdes%offset = arrdes%offset + 1*EKIND_ + 8
70 #endif
71 #else
72 arrdes%offset = arrdes%offset + size(data)*EKIND_ + 8
73 #endif
74
75 RETURN_(ESMF_SUCCESS)
76 endif
77
78
79
80 if (present(unit)) then
81 USABLE_UNIT = unit
82 else
83 USABLE_UNIT = 5 ! fortran stdin
84 end if
85
86 if(USABLE_UNIT < 0 ) then
87
88 #if (RANK_ > 2 || VARTYPE_ <= 0)
89
90 ASSERT_(.FALSE.)
91
92 #else
93
94 ASSERT_(-USABLE_UNIT<=LAST_UNIT)
95 munit => MEM_units(-USABLE_UNIT)
96 munit%prevrec = munit%prevrec + 1
97 #if (RANK_ > 0)
98 ASSERT_(associated(munit%Records(munit%prevrec)%TKR_))
99 #endif
100 data = munit%Records(munit%prevrec)%TKR_
101
102 #endif
103
104 else
105
106 if (MAPL_AM_I_ROOT(layout)) then
107 if (present(UNIT)) then
108 inquire(unit=USABLE_UNIT, formatted=FORMATTED)
109 #if (RANK_ == 1 && VARTYPE_ == 4)
110 nretries = 0
111 10 continue
112 #endif
113 if (FORMATTED == "YES") then
114 if (present(FORMAT)) then; read(USABLE_UNIT, FORMAT, IOSTAT=IOSTAT) DATA
115 else; read(USABLE_UNIT, *, IOSTAT=IOSTAT) DATA
116 end if
117 elseif(FORMATTED == "NO") then
118 read(USABLE_UNIT, IOSTAT=IOSTAT) DATA
119 end if
120 #if (RANK_ == 1 && VARTYPE_ == 4)
121 if (iostat /= 0) then
122 nretries = nretries + 1
123 print *,trim(IAM), ' read fails on attempt ',nretries
124 if (nretries < 3) goto 10
125 endif
126 #endif
127
128 if (IOSTAT < 0) then
129 inquire(unit=USABLE_UNIT, NAMED=IS_NAMED, NAME=FILENAME)
130 if (.not. IS_NAMED) then
131 FILENAME = 'UNNAMED'
132 end if
133 print *, "Premature end of file ",FILENAME
134 RETURN_(ESMF_FAILURE)
135 end if
136 else
137 if (present(FORMAT)) then; read(*, FORMAT ) DATA
138 else; read *, DATA
139 end if
140 end if
141 end if
142
143 #if (RANK_ == 0)
144 #if (VARTYPE_ == 0)
145 call MAPL_CommsBcast(layout, data, len(data), MAPL_Root, status)
146 #else
147 call MAPL_CommsBcast(layout, data, 1, MAPL_Root, status)
148 #endif
149 #else
150 call MAPL_CommsBcast(layout, data, size(data), MAPL_Root, status)
151 #endif
152 VERIFY_(status)
153
154 end if
155
156 RETURN_(ESMF_SUCCESS)
157 END SUBROUTINE SUB_
158
159 !---------------------------
160 #undef NAME_
161
162 #undef DIMENSIONS_
163 #undef RANK_
164 #undef VARTYPE_
165