← Back to branch summary

~ubuntu-branches/ubuntu/vivid/mpich/vivid-proposed

« back to all changes in this revision

Viewing changes to src/binding/f90/buildiface

  • Committer: Package Import Robot
  • Author(s): Anton Gladky
  • Date: 2014-04-01 20:24:20 UTC
  • mfrom: (5.2.4 sid)
  • Revision ID: package-import@ubuntu.com-20140401202420-t5ey1ia2klt5dkq3
Tags: 3.1-4
http://bugs.debian.org/743047
* [c3e3398] Disable test_primitives, which is unreliable on some platforms.
            (Closes: #743047)
* [265a699] Add minimal autotest.

Show diffs side-by-side

added added

removed removed

Lines of Context:
src/binding/f90/buildiface
2
2
 
3
3
# FIXME:
4
4
# TODO:
5
 
# For MPI-3 (See 17.1.3 for details), need to add (for mpi module; mpi_f08 
 
5
# For MPI-3 (See 17.1.3 for details), need to add (for mpi module; mpi_f08
6
6
# module will require different system entirely):
7
7
# *ALL* functions declared
8
8
#    This will require the use of non-standard, compiler-specific options,
9
9
#    and may require overriding user choices about warning levels and options
10
10
#    in order to handle the choice arguments
11
11
# Provide DERIVED TYPES for MPI_STATUS and all handles (as in the mpi_f08
12
 
#     module).  For all handle types, provide overloads for .EQ., .NE., == 
 
12
#     module).  For all handle types, provide overloads for .EQ., .NE., ==
13
13
#     and /= operators (Partially done)
14
14
# Check on MPI_F_SYNC_REG, mentioned on page 598.
15
15
 
40
40
%CtoFName = ();
41
41
%mpi_routines = ();
42
42
%NeedConstants = ();   # constants needed for declaration, hashed by routine
 
43
my $line_limit = 80; # Max line length
43
44
 
44
45
#
45
46
# ToDo: Fortran 90 allows some additional checks not possible in Fortran 77.
51
52
#
52
53
 
53
54
#
54
 
# parmc2f translates the C/C++ names to the Fortran 90 name.  %name% will
 
55
# argtypec2f translates the C/C++ names to the Fortran 90 name.  %name% will
55
56
# be replaced with the argument name in declarations.
56
57
#
57
58
# Some picky compilers want an interface description where Fortran 77
58
59
# was happy with a simple EXTERNAL.  To handle this, the EXTERNAL
59
60
# has a more elaborate form:
60
61
#  INTERFACE %nl%SUBROUTINE %name%(<args>)%nl%<type decls>%nl%END SUBROUTINE%nl%END INTERFACE
61
 
# where %nl% is newline/indent.  
 
62
# where %nl% is newline/indent.
62
63
#
63
 
%parmc2f = ( 'int' => 'INTEGER',
64
 
             'int[]' => 'INTEGER %name%(*)',
65
 
             'int[][3]' => 'INTEGER %name%(3,*)',
66
 
             'int*' => 'INTEGER',      # assume output scalar (see array
67
 
                                       # replacement below)
68
 
             'bool' => 'LOGICAL',
69
 
             'bool[]' => 'LOGICAL %name%(*)',
70
 
             'MPI_Handler_function*' => 'INTERFACE %nl%SUBROUTINE %name%(vv0,vv1)%nl%INTEGER vv0,vv1%nl%END SUBROUTINE%nl%END INTERFACE',
71
 
             'MPI_Win_errhandler_function*' => 'INTERFACE %nl%SUBROUTINE %name%(vv0,vv1)%nl%INTEGER vv0,vv1%nl%END SUBROUTINE%nl%END INTERFACE',
72
 
             'MPI_Comm_errhandler_function*' => 'INTERFACE %nl%SUBROUTINE %name%(vv0,vv1)%nl%INTEGER vv0,vv1%nl%END SUBROUTINE%nl%END INTERFACE',
73
 
             'MPI_File_errhandler_function*' => 'INTERFACE %nl%SUBROUTINE %name%(vv0,vv1)%nl%INTEGER vv0,vv1%nl%END SUBROUTINE%nl%END INTERFACE',
74
 
             # These other functions have <choice> (really void*) arguments
75
 
             # and so an interface spec is very hard to do in Fortran 90.
76
 
             'MPI_Comm_copy_attr_function*' => 'EXTERNAL',
77
 
             'MPI_Comm_delete_attr_function*' => 'EXTERNAL',
78
 
             'MPI_Type_copy_attr_function*' => 'EXTERNAL',
79
 
             'MPI_Type_delete_attr_function*' => 'EXTERNAL',
80
 
             'MPI_Win_copy_attr_function*' => 'EXTERNAL',
81
 
             'MPI_Win_delete_attr_function*' => 'EXTERNAL',
82
 
             'MPI_Copy_function*' => 'EXTERNAL',
83
 
             'MPI_Delete_function*' => 'EXTERNAL',
84
 
             'MPI_User_function*' => 'EXTERNAL',
85
 
             'MPI_Grequest_query_function*' => 'EXTERNAL',
86
 
             'MPI_Grequest_free_function*' => 'EXTERNAL',
87
 
             'MPI_Grequest_cancel_function*' => 'EXTERNAL',
88
 
             'MPI_Datarep_conversion_function*' => 'EXTERNAL',
89
 
             'MPI_Datarep_extent_function*' => 'EXTERNAL',
90
 
             'MPI_Request' => 'INTEGER',
91
 
             'MPI_Request*' => 'INTEGER',
92
 
             'MPI_Request[]' => 'INTEGER %name%(*)',
93
 
             'MPIO_Request' => 'INTEGER',
94
 
             'MPIO_Request*' => 'INTEGER',
95
 
             'MPI_Datatype' => 'INTEGER',
96
 
             'MPI_Datatype*' => 'INTEGER',
97
 
             'MPI_Datatype[]' => 'INTEGER %name%(*)',
98
 
             'MPI_Comm' => 'INTEGER',
99
 
             'MPI_Comm*' => 'INTEGER', # Never an array of comm
100
 
             'MPI_Group' => 'INTEGER',
101
 
             'MPI_Group*' => 'INTEGER', # Never an array of groups
102
 
             'MPI_Errhandler' => 'INTEGER',
103
 
             'MPI_Errhandler*' => 'INTEGER', # Never an array of errhandlers
104
 
             'MPI_Op' => 'INTEGER',
105
 
             'MPI_Op*' => 'INTEGER', # Never an array of ops
106
 
             'MPI_Message' => 'INTEGER',
107
 
             'MPI_Message*' => 'INTEGER', # Never an array of messages
108
 
             'MPI_Status*' => 'INTEGER %name%(MPI_STATUS_SIZE)',
109
 
             'MPI_Status[]' => 'INTEGER %name%(MPI_STATUS_SIZE,*)',
110
 
             'MPI_Aint' => 'INTEGER(KIND=MPI_ADDRESS_KIND)',
111
 
             'MPI_Aint*' => 'INTEGER(KIND=MPI_ADDRESS_KIND)',
112
 
             'MPI_Aint[]' => 'INTEGER(KIND=MPI_ADDRESS_KIND) %name%(*)',
113
 
             'MPI_Count' => 'INTEGER(KIND=MPI_COUNT_KIND)',
114
 
             'MPI_Count*' => 'INTEGER(KIND=MPI_COUNT_KIND)',
115
 
             'MPI_Offset' => 'INTEGER(KIND=MPI_OFFSET_KIND)',
116
 
             'MPI_Offset*' => 'INTEGER(KIND=MPI_OFFSET_KIND)',
117
 
             'MPI_Info' => 'INTEGER',
118
 
             'MPI_Info*' => 'INTEGER', # Never an array of info
119
 
             'MPI_Info[]' => 'INTEGER %name%(*)',
120
 
             'char*' => 'CHARACTER (LEN=*)',
121
 
             'char[]' => 'CHARACTER (LEN=*)',
122
 
             'char*[]' => 'CHARACTER (LEN=*) %name%(*)',
123
 
             'char**[]' => 'CHARACTER (LEN=*) %name%(v0,*)',  #special case
124
 
                                # from Comm_Spawn_multiple
125
 
             'MPI_Win' => 'INTEGER',
126
 
             'MPI_Win*' => 'INTEGER', # Never an array of win
127
 
             'MPI_File' => 'INTEGER',
128
 
             'MPI_File*' => 'INTEGER', # Never an array of files
129
 
             'MPI_Message' => 'INTEGER',
130
 
             'MPI_Message*' => 'INTEGER', # Never an array of messages
131
 
             );
 
64
%argtypec2f = ( 'int' => 'INTEGER',
 
65
         'int[]' => 'INTEGER %name%(*)',
 
66
         'int[][3]' => 'INTEGER %name%(3,*)',
 
67
         'int*' => 'INTEGER',      # assume output scalar (see array
 
68
                                   # replacement below)
 
69
         'bool' => 'LOGICAL',
 
70
         'bool[]' => 'LOGICAL %name%(*)',
 
71
         'MPI_Handler_function*' => 'INTERFACE %nl%SUBROUTINE %name%(vv0,vv1)%nl%INTEGER vv0,vv1%nl%END SUBROUTINE%nl%END INTERFACE',
 
72
         'MPI_Win_errhandler_function*' => 'INTERFACE %nl%SUBROUTINE %name%(vv0,vv1)%nl%INTEGER vv0,vv1%nl%END SUBROUTINE%nl%END INTERFACE',
 
73
         'MPI_Comm_errhandler_function*' => 'INTERFACE %nl%SUBROUTINE %name%(vv0,vv1)%nl%INTEGER vv0,vv1%nl%END SUBROUTINE%nl%END INTERFACE',
 
74
         'MPI_File_errhandler_function*' => 'INTERFACE %nl%SUBROUTINE %name%(vv0,vv1)%nl%INTEGER vv0,vv1%nl%END SUBROUTINE%nl%END INTERFACE',
 
75
         # These other functions have <choice> (really void*) arguments
 
76
         # and so an interface spec is very hard to do in Fortran 90.
 
77
         'MPI_Comm_copy_attr_function*' => 'EXTERNAL',
 
78
         'MPI_Comm_delete_attr_function*' => 'EXTERNAL',
 
79
         'MPI_Type_copy_attr_function*' => 'EXTERNAL',
 
80
         'MPI_Type_delete_attr_function*' => 'EXTERNAL',
 
81
         'MPI_Win_copy_attr_function*' => 'EXTERNAL',
 
82
         'MPI_Win_delete_attr_function*' => 'EXTERNAL',
 
83
         'MPI_Copy_function*' => 'EXTERNAL',
 
84
         'MPI_Delete_function*' => 'EXTERNAL',
 
85
         'MPI_User_function*' => 'EXTERNAL',
 
86
         'MPI_Grequest_query_function*' => 'EXTERNAL',
 
87
         'MPI_Grequest_free_function*' => 'EXTERNAL',
 
88
         'MPI_Grequest_cancel_function*' => 'EXTERNAL',
 
89
         'MPI_Datarep_conversion_function*' => 'EXTERNAL',
 
90
         'MPI_Datarep_extent_function*' => 'EXTERNAL',
 
91
         'MPI_Request' => 'INTEGER',
 
92
         'MPI_Request*' => 'INTEGER',
 
93
         'MPI_Request[]' => 'INTEGER %name%(*)',
 
94
         'MPIO_Request' => 'INTEGER',
 
95
         'MPIO_Request*' => 'INTEGER',
 
96
         'MPI_Datatype' => 'INTEGER',
 
97
         'MPI_Datatype*' => 'INTEGER',
 
98
         'MPI_Datatype[]' => 'INTEGER %name%(*)',
 
99
         'MPI_Comm' => 'INTEGER',
 
100
         'MPI_Comm*' => 'INTEGER', # Never an array of comm
 
101
         'MPI_Group' => 'INTEGER',
 
102
         'MPI_Group*' => 'INTEGER', # Never an array of groups
 
103
         'MPI_Errhandler' => 'INTEGER',
 
104
         'MPI_Errhandler*' => 'INTEGER', # Never an array of errhandlers
 
105
         'MPI_Op' => 'INTEGER',
 
106
         'MPI_Op*' => 'INTEGER', # Never an array of ops
 
107
         'MPI_Message' => 'INTEGER',
 
108
         'MPI_Message*' => 'INTEGER', # Never an array of messages
 
109
         'MPI_Status*' => 'INTEGER %name%(MPI_STATUS_SIZE)',
 
110
         'MPI_Status[]' => 'INTEGER %name%(MPI_STATUS_SIZE,*)',
 
111
         'MPI_Aint' => 'INTEGER(KIND=MPI_ADDRESS_KIND)',
 
112
         'MPI_Aint*' => 'INTEGER(KIND=MPI_ADDRESS_KIND)',
 
113
         'MPI_Aint[]' => 'INTEGER(KIND=MPI_ADDRESS_KIND) %name%(*)',
 
114
         'MPI_Count' => 'INTEGER(KIND=MPI_COUNT_KIND)',
 
115
         'MPI_Count*' => 'INTEGER(KIND=MPI_COUNT_KIND)',
 
116
         'MPI_Offset' => 'INTEGER(KIND=MPI_OFFSET_KIND)',
 
117
         'MPI_Offset*' => 'INTEGER(KIND=MPI_OFFSET_KIND)',
 
118
         'MPI_Info' => 'INTEGER',
 
119
         'MPI_Info*' => 'INTEGER', # Never an array of info
 
120
         'MPI_Info[]' => 'INTEGER %name%(*)',
 
121
         'char*' => 'CHARACTER (LEN=*)',
 
122
         'char[]' => 'CHARACTER (LEN=*)',
 
123
         'char*[]' => 'CHARACTER (LEN=*) %name%(*)',
 
124
         'char**[]' => 'CHARACTER (LEN=*) %name%(count,*)',  #special case
 
125
                # from Comm_Spawn_multiple
 
126
         'MPI_Win' => 'INTEGER',
 
127
         'MPI_Win*' => 'INTEGER', # Never an array of win
 
128
         'MPI_File' => 'INTEGER',
 
129
         'MPI_File*' => 'INTEGER', # Never an array of files
 
130
         'MPI_Message' => 'INTEGER',
 
131
         'MPI_Message*' => 'INTEGER', # Never an array of messages
 
132
         );
132
133
 
133
134
# special_args provides for handling of arguments that require special
134
 
# features.  The keys are of the form 'Routine-count', with count the 
 
135
# features.  The keys are of the form 'Routine-count', with count the
135
136
# position of the argument, starting from one.
136
137
%special_args = ( 'Testany-2' => 'MPI_Request[]',
137
 
                  'Testany-4' => 'bool',
138
 
                  'Startall-2' => 'MPI_Request[]',
139
 
                  'Testall-2' => 'MPI_Request[]',
140
 
                  'Testall-3' => 'bool',
141
 
                  'Testall-4' => 'MPI_Status[]',
142
 
                  'Testsome-2' => 'MPI_Request[]',
143
 
                  'Testsome-4' => 'int[]',
144
 
                  'Testsome-5' => 'MPI_Status[]',
145
 
                  'Test-2' => 'bool',
146
 
                  'Test_cancelled-2' => 'bool',
147
 
                  'Type_hindexed-2' => 'int[]',
148
 
                  'Type_hindexed-3' => 'int[]',
149
 
                  'Type_indexed-2' => 'int[]',
150
 
                  'Type_indexed-3' => 'int[]',
151
 
                  'Type_hvector-3' => 'int',
152
 
                  'Type_struct-2' => 'int[]',
153
 
                  'Type_struct-3' => 'int[]',
154
 
                  'Type_struct-4' => 'MPI_Datatype[]',
155
 
                  'Type_extent-2' => 'int',
156
 
                  'Type_lb-2' => 'int', 
157
 
                  'Type_ub-2' => 'int',
158
 
                  'Waitall-2' => 'MPI_Request[]',
159
 
                  'Waitall-3' => 'MPI_Status[]',
160
 
                  'Waitany-2' => 'MPI_Request[]',
161
 
                  'Waitsome-2' => 'MPI_Request[]',
162
 
                  'Waitsome-4' => 'int[]',
163
 
                  'Waitsome-5' => 'MPI_Status[]',
164
 
                  'Group_excl-3' => 'int[]',
165
 
                  'Group_incl-3' => 'int[]',
166
 
                  'Group_translate_ranks-3' => 'int[]',
167
 
                  'Group_translate_ranks-5' => 'int[]',
168
 
                  'Cart_coords-4' => 'int[]',
169
 
                  'Cart_create-3' => 'int[]',
170
 
                  'Cart_create-4' => 'bool[]',
171
 
                  'Cart_get-3' => 'int[]',
172
 
                  'Cart_get-5' => 'int[]',
173
 
                  'Cart_get-4' => 'bool[]',
174
 
                  'Cart_map-3' => 'int[]',
175
 
                  'Cart_map-4' => 'bool[]',
176
 
                  'Cart_rank-2' => 'int[]',
177
 
                  'Cart_sub-2' => 'bool[]',
178
 
                  'Dims_create-3' => 'int[]',
179
 
                  'Graph_create-3' => 'int[]',
180
 
                  'Graph_create-4' => 'int[]',
181
 
                  'Graph_create-5' => 'bool',
182
 
                  'Graph_get-4' => 'int[]',
183
 
                  'Graph_get-5' => 'int[]',
184
 
                  'Graph_map-3' => 'int[]',
185
 
                  'Graph_map-4' => 'int[]',
186
 
                  'Graph_neighbors-4' => 'int[]',
187
 
                  'Dist_graph_create-8' => 'bool',
188
 
                  'Dist_graph_create_adjacent-9' => 'bool',
189
 
                  'Dist_graph_neighbors_count-4' => 'bool',
190
 
                  'Allgatherv-5' => 'int[]',
191
 
                  'Allgatherv-6' => 'int[]',
192
 
                  'Alltoallv-2' => 'int[]',
193
 
                  'Alltoallv-3' => 'int[]',
194
 
                  'Alltoallv-6' => 'int[]',
195
 
                  'Alltoallv-7' => 'int[]',
196
 
                  'Alltoallw-2' => 'int[]',
197
 
                  'Alltoallw-3' => 'int[]',
198
 
                  'Alltoallw-6' => 'int[]',
199
 
                  'Alltoallw-7' => 'int[]',
200
 
                  'Gatherv-5' => 'int[]',
201
 
                  'Gatherv-6' => 'int[]',
202
 
                  'Iallgatherv-5' => 'int[]',
203
 
                  'Iallgatherv-6' => 'int[]',
204
 
                  'Ialltoallv-2' => 'int[]',
205
 
                  'Ialltoallv-3' => 'int[]',
206
 
                  'Ialltoallv-6' => 'int[]',
207
 
                  'Ialltoallv-7' => 'int[]',
208
 
                  'Ialltoallw-2' => 'int[]',
209
 
                  'Ialltoallw-3' => 'int[]',
210
 
                  'Ialltoallw-6' => 'int[]',
211
 
                  'Ialltoallw-7' => 'int[]',
212
 
                  'Igatherv-5' => 'int[]',
213
 
                  'Igatherv-6' => 'int[]',
214
 
                  'Ireduce_scatter-3' => 'int[]',
215
 
                  'Iscatterv-2' => 'int[]',
216
 
                  'Iscatterv-3' => 'int[]',
217
 
                  'Reduce_scatter-3' => 'int[]',
218
 
                  'Scatterv-2' => 'int[]',
219
 
                  'Scatterv-3' => 'int[]',
220
 
                  'Iprobe-4' => 'bool',
221
 
                  'Improbe-4' => 'bool',
222
 
                  'Op_create-2' => 'bool',
223
 
                  'Attr_get-4' => 'bool',
224
 
                  'Comm_get_attr-4' => 'bool',
225
 
                  'Type_get_attr-4' => 'bool',
226
 
                  'Win_get_attr-4' => 'bool',
227
 
                  'Comm_test_inter-2' => 'bool',
228
 
                  'Intercomm_merge-2' => 'bool',
229
 
                  'Cart_create-5' => 'bool',
230
 
                  'Initialized-1' => 'bool',            
231
 
                  'Finalized-1' => 'bool',
232
 
                  'Group_range_excl-3' => 'int[][3]',
233
 
                  'Group_range_incl-3' => 'int[][3]',
234
 
                  'Info_get_valuelen-4' => 'bool',
235
 
                  'Is_thread_main-1' => 'bool',
236
 
                  'Type_create_subarray-2' => 'int[]',
237
 
                  'Type_create_subarray-3' => 'int[]',
238
 
                  'Type_create_subarray-4' => 'int[]',
239
 
                  'Request_get_status-2' => 'bool',
240
 
                  'Status_set_cancelled-2' => 'bool',
241
 
                  'Info_get-5' => 'bool',
242
 
                  'Type_create_indexed_block-3' => 'int[]',
243
 
                  'Type_create_darray-4' => 'int[]',
244
 
                  'Type_create_darray-5' => 'int[]',
245
 
                  'Type_create_darray-6' => 'int[]',
246
 
                  'Type_create_darray-7' => 'int[]',
247
 
                  'Type_create_struct-2' => 'int[]',
248
 
                  'Type_create_struct-3' => 'MPI_Aint[]',
249
 
                  'Win_test-2' => 'bool',
250
 
                  'Type_create_hindexed-2' => 'int[]',
251
 
                  'Type_create_hindexed-3' => 'MPI_Aint[]',
252
 
                  'Op_commutative-2' => 'bool',
253
 
                  'File_set_atomicity-2' => 'bool',
254
 
                  'File_get_atomicity-2' => 'bool',
255
 
                );
 
138
          'Testany-4' => 'bool',
 
139
          'Startall-2' => 'MPI_Request[]',
 
140
          'Testall-2' => 'MPI_Request[]',
 
141
          'Testall-3' => 'bool',
 
142
          'Testall-4' => 'MPI_Status[]',
 
143
          'Testsome-2' => 'MPI_Request[]',
 
144
          'Testsome-4' => 'int[]',
 
145
          'Testsome-5' => 'MPI_Status[]',
 
146
          'Test-2' => 'bool',
 
147
          'Test_cancelled-2' => 'bool',
 
148
          'Type_hindexed-2' => 'int[]',
 
149
          'Type_hindexed-3' => 'int[]',
 
150
          'Type_indexed-2' => 'int[]',
 
151
          'Type_indexed-3' => 'int[]',
 
152
          'Type_hvector-3' => 'int',
 
153
          'Type_struct-2' => 'int[]',
 
154
          'Type_struct-3' => 'int[]',
 
155
          'Type_struct-4' => 'MPI_Datatype[]',
 
156
          'Type_extent-2' => 'int',
 
157
          'Type_lb-2' => 'int',
 
158
          'Type_ub-2' => 'int',
 
159
          'Waitall-2' => 'MPI_Request[]',
 
160
          'Waitall-3' => 'MPI_Status[]',
 
161
          'Waitany-2' => 'MPI_Request[]',
 
162
          'Waitsome-2' => 'MPI_Request[]',
 
163
          'Waitsome-4' => 'int[]',
 
164
          'Waitsome-5' => 'MPI_Status[]',
 
165
          'Group_excl-3' => 'int[]',
 
166
          'Group_incl-3' => 'int[]',
 
167
          'Group_translate_ranks-3' => 'int[]',
 
168
          'Group_translate_ranks-5' => 'int[]',
 
169
          'Cart_coords-4' => 'int[]',
 
170
          'Cart_create-3' => 'int[]',
 
171
          'Cart_create-4' => 'bool[]',
 
172
          'Cart_get-3' => 'int[]',
 
173
          'Cart_get-5' => 'int[]',
 
174
          'Cart_get-4' => 'bool[]',
 
175
          'Cart_map-3' => 'int[]',
 
176
          'Cart_map-4' => 'bool[]',
 
177
          'Cart_rank-2' => 'int[]',
 
178
          'Cart_sub-2' => 'bool[]',
 
179
          'Dims_create-3' => 'int[]',
 
180
          'Graph_create-3' => 'int[]',
 
181
          'Graph_create-4' => 'int[]',
 
182
          'Graph_create-5' => 'bool',
 
183
          'Graph_get-4' => 'int[]',
 
184
          'Graph_get-5' => 'int[]',
 
185
          'Graph_map-3' => 'int[]',
 
186
          'Graph_map-4' => 'int[]',
 
187
          'Graph_neighbors-4' => 'int[]',
 
188
          'Dist_graph_create-8' => 'bool',
 
189
          'Dist_graph_create_adjacent-9' => 'bool',
 
190
          'Dist_graph_neighbors_count-4' => 'bool',
 
191
          'Allgatherv-5' => 'int[]',
 
192
          'Allgatherv-6' => 'int[]',
 
193
          'Alltoallv-2' => 'int[]',
 
194
          'Alltoallv-3' => 'int[]',
 
195
          'Alltoallv-6' => 'int[]',
 
196
          'Alltoallv-7' => 'int[]',
 
197
          'Alltoallw-2' => 'int[]',
 
198
          'Alltoallw-3' => 'int[]',
 
199
          'Alltoallw-6' => 'int[]',
 
200
          'Alltoallw-7' => 'int[]',
 
201
          'Gatherv-5' => 'int[]',
 
202
          'Gatherv-6' => 'int[]',
 
203
          'Iallgatherv-5' => 'int[]',
 
204
          'Iallgatherv-6' => 'int[]',
 
205
          'Ialltoallv-2' => 'int[]',
 
206
          'Ialltoallv-3' => 'int[]',
 
207
          'Ialltoallv-6' => 'int[]',
 
208
          'Ialltoallv-7' => 'int[]',
 
209
          'Ialltoallw-2' => 'int[]',
 
210
          'Ialltoallw-3' => 'int[]',
 
211
          'Ialltoallw-6' => 'int[]',
 
212
          'Ialltoallw-7' => 'int[]',
 
213
          'Igatherv-5' => 'int[]',
 
214
          'Igatherv-6' => 'int[]',
 
215
          'Ireduce_scatter-3' => 'int[]',
 
216
          'Iscatterv-2' => 'int[]',
 
217
          'Iscatterv-3' => 'int[]',
 
218
          'Reduce_scatter-3' => 'int[]',
 
219
          'Scatterv-2' => 'int[]',
 
220
          'Scatterv-3' => 'int[]',
 
221
          'Iprobe-4' => 'bool',
 
222
          'Improbe-4' => 'bool',
 
223
          'Op_create-2' => 'bool',
 
224
          'Attr_get-4' => 'bool',
 
225
          'Comm_get_attr-4' => 'bool',
 
226
          'Type_get_attr-4' => 'bool',
 
227
          'Win_get_attr-4' => 'bool',
 
228
          'Comm_test_inter-2' => 'bool',
 
229
          'Intercomm_merge-2' => 'bool',
 
230
          'Cart_create-5' => 'bool',
 
231
          'Initialized-1' => 'bool',
 
232
          'Finalized-1' => 'bool',
 
233
          'Group_range_excl-3' => 'int[][3]',
 
234
          'Group_range_incl-3' => 'int[][3]',
 
235
          'Info_get_valuelen-4' => 'bool',
 
236
          'Is_thread_main-1' => 'bool',
 
237
          'Type_create_subarray-2' => 'int[]',
 
238
          'Type_create_subarray-3' => 'int[]',
 
239
          'Type_create_subarray-4' => 'int[]',
 
240
          'Request_get_status-2' => 'bool',
 
241
          'Status_set_cancelled-2' => 'bool',
 
242
          'Info_get-5' => 'bool',
 
243
          'Type_create_indexed_block-3' => 'int[]',
 
244
          'Type_create_darray-4' => 'int[]',
 
245
          'Type_create_darray-5' => 'int[]',
 
246
          'Type_create_darray-6' => 'int[]',
 
247
          'Type_create_darray-7' => 'int[]',
 
248
          'Type_create_struct-2' => 'int[]',
 
249
          'Type_create_struct-3' => 'MPI_Aint[]',
 
250
          'Win_test-2' => 'bool',
 
251
          'Type_create_hindexed-2' => 'int[]',
 
252
          'Type_create_hindexed-3' => 'MPI_Aint[]',
 
253
          'Op_commutative-2' => 'bool',
 
254
          'File_set_atomicity-2' => 'bool',
 
255
          'File_get_atomicity-2' => 'bool',
 
256
        );
256
257
 
257
258
# Some routines must be skipped (custom code is provided for them)
258
259
%skip_routines = ( 'Init' => 1, 'Init_thread' => 1, 'Status_c2f' => 1,
259
 
                   'Status_f2c' => 1, 'Pcontrol' => 1,
260
 
                   );
 
260
           'Status_f2c' => 1, 'Pcontrol' => 1,
 
261
           );
261
262
 
262
263
# Some routines *may* be skipped if we don't want to handle the possibility
263
264
# of a scalar or vector argument
265
266
# For each of these, we need to know which arguments are the "scalar/vector"
266
267
# The value of the hash gives us the answer, indexed from 1
267
268
# (these are not correct yet).
268
 
%scalarVectorRoutines = ( 'Startall' => '2-1', 'Testall' => '2-1:4-1', 
269
 
                          'Testany' => '2-1',
270
 
                          'Testsome' => '2-1:4-1:5-1', 
271
 
                          'Waitall' => '2-1:3-1', 'Waitany' => '2-1',
272
 
                          'Waitsome' => '2-1:4-1:5-1', 
273
 
                          'Dims_create' => '3-2', 
274
 
                          'Cart_rank' => '2', 'Cart_coords' => '4-3', 
275
 
                          'Cart_get' => '3-2:4-2:5-2', 
276
 
                          'Graph_neighbors' => '4-3', 
277
 
                          'Cart_sub' => '2',
278
 
                          'Cart_map' => '3-2:4-2',
279
 
                          'Cart_create' => '3-2:4-2',
280
 
                          'Graph_create' => '3:4',
281
 
                          'Dist_graph_create' => '6',
282
 
                          'Dist_graph_create_adjacent' => '4:7',
283
 
                          'Dist_graph_neighbors' => '4:7',
284
 
                          'Group_translate_ranks' => '3-2:5-2',
 
269
%scalarVectorRoutines = ( 'Startall' => '2-1', 'Testall' => '2-1:4-1',
 
270
              'Testany' => '2-1',
 
271
              'Testsome' => '2-1:4-1:5-1',
 
272
              'Waitall' => '2-1:3-1', 'Waitany' => '2-1',
 
273
              'Waitsome' => '2-1:4-1:5-1',
 
274
              'Dims_create' => '3-2',
 
275
              'Cart_rank' => '2', 'Cart_coords' => '4-3',
 
276
              'Cart_get' => '3-2:4-2:5-2',
 
277
              'Graph_neighbors' => '4-3',
 
278
              'Cart_sub' => '2',
 
279
              'Cart_map' => '3-2:4-2',
 
280
              'Cart_create' => '3-2:4-2',
 
281
              'Graph_create' => '3:4',
 
282
              'Dist_graph_create' => '6',
 
283
              'Dist_graph_create_adjacent' => '4:7',
 
284
              'Dist_graph_neighbors' => '4:7',
 
285
              'Group_translate_ranks' => '3-2:5-2',
285
286
 
286
287
    );
287
288
 
292
293
# Process any options
293
294
foreach $_ (@ARGV) {
294
295
    if (/--?prototype=(.*)/) {
295
 
        $prototype_file = $1;
 
296
    $prototype_file = $1;
296
297
    }
297
298
    elsif (/--?sv/) {
298
 
        # This obscure argument enables the creation of an interface that
299
 
        # includes the routines that can accept a scalar or a vector
300
 
        # (e.g., a single request or an array of requests) on a single 
301
 
        # type (e.g., an integer).  By default, we leave these out.
302
 
        $buildScalarVector = 1;
 
299
    # This obscure argument enables the creation of an interface that
 
300
    # includes the routines that can accept a scalar or a vector
 
301
    # (e.g., a single request or an array of requests) on a single
 
302
    # type (e.g., an integer).  By default, we leave these out.
 
303
    $buildScalarVector = 1;
303
304
    }
304
305
    elsif (/deffile=(.*)/) {
305
 
        $definition_file = $1;
306
 
        $is_MPI = 0;
 
306
    $definition_file = $1;
 
307
    $is_MPI = 0;
307
308
    }
308
309
    elsif (/--?noio/) {
309
 
        $build_io = 0;
 
310
    $build_io = 0;
310
311
    }
311
312
    elsif (/--?debug/) { $gDebug = 1; }
312
313
    else {
313
 
        print STDERR "Unrecognized argument $_\n";
314
 
        exit 2;
 
314
    print STDERR "Unrecognized argument $_\n";
 
315
    exit 2;
315
316
    }
316
317
}
317
318
 
323
324
$ucoutfile_prefix = uc( $outfile_prefix );
324
325
 
325
326
#
326
 
# Read the interface file (e.g., mpi.h.in) and file in the various 
 
327
# Read the interface file (e.g., mpi.h.in) and file in the various
327
328
# data structures (they're in global variables)
328
329
&ReadInterface( $prototype_file, $routine_prefix, $routine_pattern, "mpi_routines" );
329
 
if ( -s "../../mpi/romio/include/mpio.h.in" && $build_io) { 
330
 
#    %skipBlocks = ( 'HAVE_MPI_DARRAY_SUBARRAY' => 1, 
331
 
#                  'HAVE_MPI_INFO' => 1,
332
 
#                   'MPICH' => 1 );
 
330
if ( -s "../../mpi/romio/include/mpio.h.in" && $build_io) {
 
331
#    %skipBlocks = ( 'HAVE_MPI_DARRAY_SUBARRAY' => 1,
 
332
#           'HAVE_MPI_INFO' => 1,
 
333
#            'MPICH' => 1 );
333
334
    &ReadInterface( "../../mpi/romio/include/mpio.h.in", $routine_prefix,
334
 
        $routine_pattern, "mpi_routines" );
 
335
    $routine_pattern, "mpi_routines" );
335
336
#    %skipBlocks = ();
336
337
}
337
338
if ( $buildMPIX ) {
339
340
}
340
341
 
341
342
#
342
 
# For some MPI routines, we need to distinguish between arguments that are 
 
343
# For some MPI routines, we need to distinguish between arguments that are
343
344
# input arrays versus ones that are output scalars.  For those functions,
344
 
# convert input (or output) arrays to [] format.  
 
345
# convert input (or output) arrays to [] format.
345
346
 
346
347
# ----------------------------------------------------------------------------
347
348
#
350
351
# Print header
351
352
open (MPIFD, ">${outfile_prefix}.f90.new" ) || die "Could not open ${outfile_prefix}.f90.new\n";
352
353
 
353
 
# Was 
 
354
# Was
354
355
#       USE MPI_CONSTANTS,                                               &
355
356
#     &      BASE_MPI_WTIME => MPI_WTIME, BASE_MPI_WTICK => MPI_WTICK
356
357
# but this caused problems with the pg compiler.  Need to understand and fix
363
364
       USE ${ucoutfile_prefix}_SIZEOFS
364
365
       USE ${ucoutfile_prefix}_BASE
365
366
       END MODULE $ucoutfile_prefix\n";
366
 
  
 
367
 
367
368
close (MPIFD);
368
369
&ReplaceIfDifferent( "${outfile_prefix}.f90", "${outfile_prefix}.f90.new" );
369
370
 
370
371
# ----------------------------------------------------------------------------
371
372
# This is the file for the routines that have no "choice" arguments.
372
 
# An example of a choice argument is a "void *buf" input argument to 
 
373
# An example of a choice argument is a "void *buf" input argument to
373
374
# MPI_Send, which allows any buffer address, both numeric and character.
374
375
open ( MPIBASEFD, ">${outfile_prefix}_base.f90.in.new" ) || die "Could not open ${outfile_prefix}_base.f90.in.new\n";
375
376
print MPIBASEFD "!     -*- Mode: Fortran; -*-
376
377
!  (C) 2008 by Argonne National Laboratory.
377
 
!      See COPYRIGHT in top-level directory.       
 
378
!      See COPYRIGHT in top-level directory.
378
379
       MODULE ${ucoutfile_prefix}_BASE
379
380
       IMPLICIT NONE
380
381
!      This module was created by the script buildiface
381
382
       INTERFACE\n";
382
383
 
383
384
foreach $routine (keys(%mpi_routines)) {
384
 
    # Permit each package to define a new name for the Fortran version of the 
 
385
    # Permit each package to define a new name for the Fortran version of the
385
386
    # routine
386
387
    if (defined($CtoFName{$routine})) {
387
 
        $routine = $CtoFName{$routine};
 
388
        $routine = $CtoFName{$routine};
388
389
    }
389
390
    $ucname = uc($routine);
390
 
    $args   = $mpi_routines{$routine};
391
 
    @parms  = split(/,/, $args );
 
391
    my @argtypes = split(/,/, $mpi_routines{$routine}[0]);
 
392
    my @argnames = split(/,/, $mpi_routines{$routine}[1]);
392
393
 
393
 
    print "$routine\n" if $gDebug;
 
394
    print "Trying to bind $routine\n" if $gDebug;
394
395
    # Check for a routine to skip
395
396
    if (defined($skip_routines{$routine})) {
396
 
        next;
 
397
        print "Skipping $routine as required\n" if $gDebug;
 
398
        next;
397
399
    }
398
400
 
399
401
    if (defined($scalarVectorRoutines{$routine})) {
400
 
        # These require special processing in any case
401
 
        next;
 
402
        # These require special processing in any case
 
403
        next;
402
404
    }
403
405
 
404
406
    # Check for a void * argument (usually choice)
405
407
    # As noted above, we don't include the routines with choice arguments
406
408
    # in the base module.
407
 
    if ($args =~ /void/) {
408
 
        $mpi_choice_routines{$routine} = $args;
409
 
        print "Skipping $routine because of void argument\n" if $gDebug;
410
 
        next;
411
 
    }
412
 
    print MPIBASEFD "       SUBROUTINE $out_prefix$ucname(";
413
 
    for ($i=0; $i<=$#parms; $i++) {
414
 
        print MPIBASEFD "v$i,";
415
 
    }
416
 
    print MPIBASEFD "ierror)\n";
 
409
 
 
410
    if ($mpi_routines{$routine}[0] =~ /void/) {
 
411
        $mpi_choice_routines{$routine} = $mpi_routines{$routine}[0];
 
412
        print "Skipping $routine because of void argument\n" if $gDebug;
 
413
        next;
 
414
    }
 
415
 
 
416
    print MPIBASEFD "      SUBROUTINE $out_prefix$ucname";
 
417
    &PrintArgBrace(MPIBASEFD,
 
418
        length("      SUBROUTINE $out_prefix$ucname"),
 
419
        length("      SUBROUTINE  "),
 
420
        $line_limit,
 
421
        @argnames);
417
422
    &PrintArgDecls( $routine, 0, "" );
418
 
    print MPIBASEFD "       END SUBROUTINE $out_prefix$ucname\n\n";
 
423
    print MPIBASEFD "      END SUBROUTINE $out_prefix$ucname\n\n";
419
424
}
420
425
 
421
426
# Add special routines (e.g., the ones with unusual arguments)
425
430
# preferable to DOUBLE PRECISION (in cases where the user is permitted
426
431
# to change the size of these basic types(!)).  This script must produce
427
432
# a standard-conforming file.  The top-level configure (in mpich/configure)
428
 
# will replace DOUBLE PRECISION with REAL*8 if the Fortran compiler 
 
433
# will replace DOUBLE PRECISION with REAL*8 if the Fortran compiler
429
434
# supports REAL*8.
430
435
if ($is_MPI) {
431
436
    print MPIBASEFD "
453
458
            \@WTIME_DOUBLE_TYPE\@ PMPI_WTICK
454
459
        END FUNCTION PMPI_WTICK
455
460
 
456
 
        SUBROUTINE MPI_NULL_DELETE_FN(a,b,c,d,e)
457
 
          INTEGER a,b,c,d,e
 
461
        SUBROUTINE MPI_NULL_DELETE_FN(COMM, KEYVAL, ATTRIBUTE_VAL,&
 
462
          EXTRA_STATE, IERROR)
 
463
            USE MPI_CONSTANTS,ONLY: MPI_ADDRESS_KIND
 
464
            INTEGER COMM, KEYVAL, IERROR
 
465
            INTEGER(KIND=MPI_ADDRESS_KIND) ATTRIBUTE_VAL, EXTRA_STATE
458
466
        END SUBROUTINE MPI_NULL_DELETE_FN
459
467
 
460
 
        SUBROUTINE MPI_DUP_FN(a,b,c,d,e,f,g)
461
 
          INTEGER a,b,c,d,e,g
462
 
          LOGICAL f
 
468
        SUBROUTINE MPI_DUP_FN(OLDCOMM, KEYVAL, EXTRA_STATE,&
 
469
          ATTRIBUTE_VAL_IN, ATTRIBUTE_VAL_OUT, FLAG, IERROR)
 
470
            USE MPI_CONSTANTS,ONLY: MPI_ADDRESS_KIND
 
471
            INTEGER OLDCOMM, KEYVAL, IERROR
 
472
            INTEGER(KIND=MPI_ADDRESS_KIND) EXTRA_STATE, ATTRIBUTE_VAL_IN, ATTRIBUTE_VAL_OUT
 
473
            LOGICAL FLAG
463
474
        END SUBROUTINE MPI_DUP_FN
464
475
 
465
 
        SUBROUTINE MPI_NULL_COPY_FN(a,b,c,d,e,f,g)
466
 
          INTEGER a,b,c,d,e,g
467
 
          LOGICAL f
 
476
        SUBROUTINE MPI_NULL_COPY_FN(OLDCOMM, KEYVAL, EXTRA_STATE,&
 
477
          ATTRIBUTE_VAL_IN, ATTRIBUTE_VAL_OUT, FLAG, IERROR)
 
478
            USE MPI_CONSTANTS,ONLY: MPI_ADDRESS_KIND
 
479
            INTEGER OLDCOMM, KEYVAL, IERROR
 
480
            INTEGER(KIND=MPI_ADDRESS_KIND) EXTRA_STATE, ATTRIBUTE_VAL_IN, ATTRIBUTE_VAL_OUT
 
481
            LOGICAL FLAG
468
482
        END SUBROUTINE MPI_NULL_COPY_FN
469
483
 
470
 
        SUBROUTINE MPI_COMM_NULL_DELETE_FN(a,b,c,d,e)
471
 
          USE MPI_CONSTANTS,ONLY: MPI_ADDRESS_KIND
472
 
          INTEGER a,b,e
473
 
          INTEGER (KIND=MPI_ADDRESS_KIND) c, d
 
484
        SUBROUTINE MPI_COMM_NULL_DELETE_FN(COMM, COMM_KEYVAL, ATTRIBUTE_VAL,&
 
485
          EXTRA_STATE, IERROR)
 
486
            USE MPI_CONSTANTS,ONLY: MPI_ADDRESS_KIND
 
487
            INTEGER COMM, COMM_KEYVAL, IERROR
 
488
            INTEGER(KIND=MPI_ADDRESS_KIND) ATTRIBUTE_VAL, EXTRA_STATE
474
489
        END SUBROUTINE MPI_COMM_NULL_DELETE_FN
475
490
 
476
 
        SUBROUTINE MPI_COMM_DUP_FN(a,b,c,d,e,f,g)
477
 
          USE MPI_CONSTANTS,ONLY: MPI_ADDRESS_KIND
478
 
          INTEGER a,b,g
479
 
          INTEGER (KIND=MPI_ADDRESS_KIND) c,d,e
480
 
          LOGICAL f
 
491
        SUBROUTINE MPI_COMM_DUP_FN(OLDCOMM, COMM_KEYVAL, EXTRA_STATE,&
 
492
          ATTRIBUTE_VAL_IN, ATTRIBUTE_VAL_OUT, FLAG, IERROR)
 
493
            USE MPI_CONSTANTS,ONLY: MPI_ADDRESS_KIND
 
494
            INTEGER OLDCOMM, COMM_KEYVAL, IERROR
 
495
            INTEGER(KIND=MPI_ADDRESS_KIND) EXTRA_STATE, ATTRIBUTE_VAL_IN, ATTRIBUTE_VAL_OUT
 
496
            LOGICAL FLAG
481
497
        END SUBROUTINE MPI_COMM_DUP_FN
482
498
 
483
 
        SUBROUTINE MPI_COMM_NULL_COPY_FN(a,b,c,d,e,f,g)
484
 
          USE MPI_CONSTANTS,ONLY: MPI_ADDRESS_KIND
485
 
          INTEGER a,b,g
486
 
          INTEGER (KIND=MPI_ADDRESS_KIND) c,d,e
487
 
          LOGICAL f
 
499
        SUBROUTINE MPI_COMM_NULL_COPY_FN(OLDCOMM, COMM_KEYVAL, EXTRA_STATE,&
 
500
          ATTRIBUTE_VAL_IN, ATTRIBUTE_VAL_OUT, FLAG, IERROR)
 
501
            USE MPI_CONSTANTS,ONLY: MPI_ADDRESS_KIND
 
502
            INTEGER OLDCOMM, COMM_KEYVAL, IERROR
 
503
            INTEGER(KIND=MPI_ADDRESS_KIND) EXTRA_STATE, ATTRIBUTE_VAL_IN, ATTRIBUTE_VAL_OUT
 
504
            LOGICAL FLAG
488
505
        END SUBROUTINE MPI_COMM_NULL_COPY_FN
489
506
 
490
 
        SUBROUTINE MPI_TYPE_NULL_DELETE_FN(a,b,c,d,e)
491
 
          USE MPI_CONSTANTS,ONLY: MPI_ADDRESS_KIND
492
 
          INTEGER a,b,e
493
 
          INTEGER (KIND=MPI_ADDRESS_KIND) c, d
 
507
        SUBROUTINE MPI_TYPE_NULL_DELETE_FN(DATATYPE, TYPE_KEYVAL, ATTRIBUTE_VAL,&
 
508
          EXTRA_STATE, IERROR)
 
509
            USE MPI_CONSTANTS,ONLY: MPI_ADDRESS_KIND
 
510
            INTEGER DATATYPE, TYPE_KEYVAL, IERROR
 
511
            INTEGER(KIND=MPI_ADDRESS_KIND) ATTRIBUTE_VAL, EXTRA_STATE
494
512
        END SUBROUTINE MPI_TYPE_NULL_DELETE_FN
495
513
 
496
 
        SUBROUTINE MPI_TYPE_DUP_FN(a,b,c,d,e,f,g)
497
 
          USE MPI_CONSTANTS,ONLY: MPI_ADDRESS_KIND
498
 
          INTEGER a,b,g
499
 
          INTEGER (KIND=MPI_ADDRESS_KIND) c,d,e
500
 
          LOGICAL f
 
514
        SUBROUTINE MPI_TYPE_DUP_FN(OLDTYPE, TYPE_KEYVAL, EXTRA_STATE,&
 
515
          ATTRIBUTE_VAL_IN, ATTRIBUTE_VAL_OUT, FLAG, IERROR)
 
516
            USE MPI_CONSTANTS,ONLY: MPI_ADDRESS_KIND
 
517
            INTEGER OLDTYPE, TYPE_KEYVAL, IERROR
 
518
            INTEGER(KIND=MPI_ADDRESS_KIND) EXTRA_STATE, ATTRIBUTE_VAL_IN, ATTRIBUTE_VAL_OUT
 
519
            LOGICAL FLAG
501
520
        END SUBROUTINE MPI_TYPE_DUP_FN
502
521
 
503
 
        SUBROUTINE MPI_TYPE_NULL_COPY_FN(a,b,c,d,e,f,g)
504
 
          USE MPI_CONSTANTS,ONLY: MPI_ADDRESS_KIND
505
 
          INTEGER a,b,g
506
 
          INTEGER (KIND=MPI_ADDRESS_KIND) c,d,e
507
 
          LOGICAL f
 
522
        SUBROUTINE MPI_TYPE_NULL_COPY_FN(OLDTYPE, TYPE_KEYVAL, EXTRA_STATE,&
 
523
          ATTRIBUTE_VAL_IN, ATTRIBUTE_VAL_OUT, FLAG, IERROR)
 
524
            USE MPI_CONSTANTS,ONLY: MPI_ADDRESS_KIND
 
525
            INTEGER OLDTYPE, TYPE_KEYVAL, IERROR
 
526
            INTEGER(KIND=MPI_ADDRESS_KIND) EXTRA_STATE, ATTRIBUTE_VAL_IN, ATTRIBUTE_VAL_OUT
 
527
            LOGICAL FLAG
508
528
        END SUBROUTINE MPI_TYPE_NULL_COPY_FN
509
529
 
510
 
        SUBROUTINE MPI_WIN_NULL_DELETE_FN(a,b,c,d,e)
511
 
          USE MPI_CONSTANTS,ONLY: MPI_ADDRESS_KIND
512
 
          INTEGER a,b,e
513
 
          INTEGER (KIND=MPI_ADDRESS_KIND) c, d
 
530
        SUBROUTINE MPI_WIN_NULL_DELETE_FN(WIN, WIN_KEYVAL, ATTRIBUTE_VAL,&
 
531
          EXTRA_STATE, IERROR)
 
532
            USE MPI_CONSTANTS,ONLY: MPI_ADDRESS_KIND
 
533
            INTEGER WIN, WIN_KEYVAL, IERROR
 
534
            INTEGER(KIND=MPI_ADDRESS_KIND) ATTRIBUTE_VAL, EXTRA_STATE
514
535
        END SUBROUTINE MPI_WIN_NULL_DELETE_FN
515
536
 
516
 
        SUBROUTINE MPI_WIN_DUP_FN(a,b,c,d,e,f,g)
517
 
          USE MPI_CONSTANTS,ONLY: MPI_ADDRESS_KIND
518
 
          INTEGER a,b,g
519
 
          INTEGER (KIND=MPI_ADDRESS_KIND) c,d,e
520
 
          LOGICAL f
 
537
        SUBROUTINE MPI_WIN_DUP_FN(OLDWIN, WIN_KEYVAL, EXTRA_STATE,&
 
538
          ATTRIBUTE_VAL_IN, ATTRIBUTE_VAL_OUT, FLAG, IERROR)
 
539
            USE MPI_CONSTANTS,ONLY: MPI_ADDRESS_KIND
 
540
            INTEGER OLDWIN, WIN_KEYVAL, IERROR
 
541
            INTEGER(KIND=MPI_ADDRESS_KIND) EXTRA_STATE, ATTRIBUTE_VAL_IN, ATTRIBUTE_VAL_OUT
 
542
            LOGICAL FLAG
521
543
        END SUBROUTINE MPI_WIN_DUP_FN
522
544
 
523
 
        SUBROUTINE MPI_WIN_NULL_COPY_FN(a,b,c,d,e,f,g)
524
 
          USE MPI_CONSTANTS,ONLY: MPI_ADDRESS_KIND
525
 
          INTEGER a,b,g
526
 
          INTEGER (KIND=MPI_ADDRESS_KIND) c,d,e
527
 
          LOGICAL f
 
545
        SUBROUTINE MPI_WIN_NULL_COPY_FN(OLDWIN, WIN_KEYVAL, EXTRA_STATE,&
 
546
          ATTRIBUTE_VAL_IN, ATTRIBUTE_VAL_OUT, FLAG, IERROR)
 
547
            USE MPI_CONSTANTS,ONLY: MPI_ADDRESS_KIND
 
548
            INTEGER OLDWIN, WIN_KEYVAL, IERROR
 
549
            INTEGER(KIND=MPI_ADDRESS_KIND) EXTRA_STATE, ATTRIBUTE_VAL_IN, ATTRIBUTE_VAL_OUT
 
550
            LOGICAL FLAG
528
551
        END SUBROUTINE MPI_WIN_NULL_COPY_FN
529
 
 
530
552
";
531
553
}
532
554
# Here's where we need to place the interface definitions for the functions
533
 
# that take vector or scalar arguments (startall, testall/any/some, 
 
555
# that take vector or scalar arguments (startall, testall/any/some,
534
556
# waitall/any/some, group_translate_ranks, etc.)
535
 
# For each such routine, we need to generate two entries.  Here's the 
 
557
# For each such routine, we need to generate two entries.  Here's the
536
558
# example for STARTALL:
537
559
#     subroutine MPI_STARTALL_S(c,r,ierr)
538
560
#     integer c,r,ierr
550
572
if ($buildScalarVector) {
551
573
    # Create the interface modules
552
574
    foreach my $routine (keys(%scalarVectorRoutines)) {
553
 
        $ucname = uc($routine);
554
 
        print MPIBASEFD "       INTERFACE ${out_prefix}$ucname\n";
 
575
    $ucname = uc($routine);
 
576
    print MPIBASEFD "       INTERFACE ${out_prefix}$ucname\n";
555
577
        print MPIBASEFD "           MODULE PROCEDURE ${out_prefix}${ucname}_S\n";
556
578
        print MPIBASEFD "           MODULE PROCEDURE ${out_prefix}${ucname}_V\n";
557
 
        print MPIBASEFD "       END INTERFACE ! ${out_prefix}$ucname\n\n";
558
 
        
 
579
    print MPIBASEFD "       END INTERFACE ! ${out_prefix}$ucname\n\n";
 
580
 
559
581
    }
560
582
    print MPIBASEFD "\n        CONTAINS\n";
561
583
    # This is much like the base name (interface) block code
562
584
    foreach my $routine (keys(%scalarVectorRoutines)) {
563
 
        $ucname = uc($routine);
564
 
        $args   = $mpi_routines{$routine};
565
 
        @parms  = split(/,/, $args );
566
 
        $svArgs = $scalarVectorRoutines{$routine};
567
 
        # The scalar version
568
 
        print MPIBASEFD "       SUBROUTINE ${out_prefix}${ucname}_S(";
569
 
        for ($i=0; $i<=$#parms; $i++) {
570
 
            print MPIBASEFD "v$i,";
571
 
        }
572
 
        print MPIBASEFD "ierror)\n";
573
 
        &PrintArgDecls( $routine, 1, $svArgs );
574
 
        print MPIBASEFD "       EXTERNAL ${out_prefix}${ucname}\n";
575
 
        print MPIBASEFD "       call ${out_prefix}$ucname(";
576
 
        for ($i=0; $i<=$#parms; $i++) {
577
 
            print MPIBASEFD "v$i,";
578
 
        }
579
 
        print MPIBASEFD "ierror)\n";
580
 
 
581
 
        print MPIBASEFD "       END SUBROUTINE ${out_prefix}${ucname}_S\n\n";
582
 
 
583
 
        # The vector version
 
585
        $ucname = uc($routine);
 
586
        my @argtypes  = split(/,/, $mpi_routines{$routine}[0]);
 
587
        my @argnames  = split(/,/, $mpi_routines{$routine}[1]);
 
588
        $svArgs = $scalarVectorRoutines{$routine};
 
589
 
 
590
        # The scalar version
 
591
        print MPIBASEFD "       SUBROUTINE ${out_prefix}${ucname}_S";
 
592
        &PrintArgBrace(MPIBASEFD,
 
593
            length("       SUBROUTINE ${out_prefix}${ucname}_S"),
 
594
            length("       SUBROUTINE  "),
 
595
            $line_limit,
 
596
            @argnames);
 
597
        &PrintArgDecls( $routine, 1, $svArgs );
 
598
 
 
599
        print MPIBASEFD "       EXTERNAL ${out_prefix}${ucname}\n";
 
600
        print MPIBASEFD "       call ${out_prefix}$ucname";
 
601
        &PrintArgBrace(MPIBASEFD,
 
602
            length("       call ${out_prefix}$ucname"),
 
603
            length("       call  "),
 
604
            $line_limit,
 
605
            @argnames);
 
606
        print MPIBASEFD "       END SUBROUTINE ${out_prefix}${ucname}_S\n\n";
 
607
 
 
608
        # The vector version
584
609
        print MPIBASEFD "       SUBROUTINE ${out_prefix}${ucname}_V(";
585
 
        for ($i=0; $i<=$#parms; $i++) {
586
 
            print MPIBASEFD "v$i,";
587
 
        }
588
 
        print MPIBASEFD "ierror)\n";
589
 
        &PrintArgDecls( $routine, 0, "" );
590
 
        print MPIBASEFD "       EXTERNAL ${out_prefix}${ucname}\n";
591
 
        print MPIBASEFD "       call ${out_prefix}$ucname(";
592
 
        for ($i=0; $i<=$#parms; $i++) {
593
 
            print MPIBASEFD "v$i,";
594
 
        }
595
 
        print MPIBASEFD "ierror)\n";
596
 
 
597
 
        print MPIBASEFD "       END SUBROUTINE ${out_prefix}${ucname}_V\n\n";
598
 
 
 
610
        &PrintArgBrace(MPIBASEFD,
 
611
            length("       SUBROUTINE ${out_prefix}${ucname}_S"),
 
612
            length("       SUBROUTINE  "),
 
613
            $line_limit,
 
614
            @argnames);
 
615
        &PrintArgDecls( $routine, 0, "" );
 
616
 
 
617
        print MPIBASEFD "       EXTERNAL ${out_prefix}${ucname}\n";
 
618
        print MPIBASEFD "       call ${out_prefix}$ucname";
 
619
        &PrintArgBrace(MPIBASEFD,
 
620
            length("       call ${out_prefix}$ucname"),
 
621
            length("       call  "),
 
622
            $line_limit,
 
623
            @argnames);
 
624
        print MPIBASEFD "       END SUBROUTINE ${out_prefix}${ucname}_V\n\n";
599
625
    }
600
626
}
601
627
 
603
629
close MPIBASEFD;
604
630
&ReplaceIfDifferent( "${outfile_prefix}_base.f90.in", "${outfile_prefix}_base.f90.in.new" );
605
631
 
606
 
open ( MPIFD, ">${outfile_prefix}_constants.f90.new" ) || die "Cannot open ${outfile_prefix}_constants.f90.new\n";
 
632
open ( MPIFD, ">${outfile_prefix}_constants.f90.in.new" ) || die "Cannot open ${outfile_prefix}_constants.f90.in.new\n";
607
633
print MPIFD "!     -*- Mode: Fortran; -*-
608
634
!  (C) 2008 by Argonne National Laboratory.
609
635
!       See COPYRIGHT in top-level directory.
612
638
        INCLUDE 'mpifnoext.h'\n";
613
639
# MPI-3 Requires that even the MPI module (not just mpi_f08) include
614
640
# the MPI_Status type, as well as handle types
615
 
# WARNING: If there is and "EXTRA_STATUS_DECL", this declaration is
616
 
# erroneous
617
641
# WARNING: INTEGER is incorrect; it should be INTEGER(C_INT) if this
618
642
# is to be used directly by a C routine.  That may also require using
619
643
# USE ISO_C_BINDING, ONLY :: C_INT
642
666
#
643
667
#$BINDACCESS = ", BIND(C)";
644
668
#$BINDDEF ="";
 
669
# Yet another problem.
 
670
# Because MPI_Count may be longer than a single (Fortran) INTEGER,
 
671
# alignment restrictions may introduce padding in the structure
 
672
# And one more problem: If a Fortran INTEGER is not the same as a C int,
 
673
# then these are also wrong (see the "fint" option in
 
674
# src/binding/f77/buildiface
645
675
print MPIFD <<EOT;
646
676
        TYPE$BINDACCESS :: MPI_Status
647
677
           $BINDDEF
648
678
           INTEGER$PUBLICVAR :: MPI_SOURCE, MPI_TAG, MPI_ERROR
649
 
           INTEGER$PRIVATEVAR(KIND=MPI_COUNT_KIND) :: count
650
 
           INTEGER$PRIVATEVAR :: cancelled
651
 
           INTEGER$PRIVATEVAR(2) :: abi_slush_fund
 
679
           INTEGER$PRIVATEVAR :: count_lo
 
680
           INTEGER$PRIVATEVAR :: count_hi_and_cancelled
652
681
        END TYPE MPI_Status
653
682
EOT
654
683
 
655
 
%handles = ( 'comm' => 'Comm', 'datatype' => 'Datatype', 
656
 
             'group' => 'Group', 'win' => 'Win', 
657
 
             'file' => 'File', 'op' => 'Op', 'errhandler' => 'Errhandler',
658
 
             'request' => 'Request', 'message' => 'Message', 
659
 
             'info' => 'Info' );
 
684
%handles = ( 'comm' => 'Comm', 'datatype' => 'Datatype',
 
685
         'group' => 'Group', 'win' => 'Win',
 
686
         'file' => 'File', 'op' => 'Op', 'errhandler' => 'Errhandler',
 
687
         'request' => 'Request', 'message' => 'Message',
 
688
         'info' => 'Info' );
660
689
 
661
690
foreach $handle (keys(%handles)) {
662
691
    $mpitype = $handles{$handle};
708
737
 
709
738
print MPIFD "        END MODULE ${ucoutfile_prefix}_CONSTANTS\n";
710
739
close MPIFD;
711
 
&ReplaceIfDifferent( "${outfile_prefix}_constants.f90", "${outfile_prefix}_constants.f90.new" );
 
740
&ReplaceIfDifferent( "${outfile_prefix}_constants.f90.in", "${outfile_prefix}_constants.f90.in.new" );
712
741
 
713
742
#
714
743
# Generate the choice argument routines
715
 
# FIXME: This file is not quite right.  Also note that it is 
716
 
# *input* for yet another step, one that generates particular values 
717
 
# for the types of the choice arguments.  We should consider using 
718
 
# a different extension for this file, such as sed or in, so that 
 
744
# FIXME: This file is not quite right.  Also note that it is
 
745
# *input* for yet another step, one that generates particular values
 
746
# for the types of the choice arguments.  We should consider using
 
747
# a different extension for this file, such as sed or in, so that
719
748
# it is clearly not a ready-to-use Fortran 90 input file.
720
749
# In particular, it needs to be set up so that
721
750
#   <typesize>
757
786
# For each choice routine, add the modules
758
787
foreach $routine (keys(%mpi_choice_routines)) {
759
788
    $ucname = uc($routine);
760
 
    $args   = $mpi_routines{$routine};
761
 
    @parms  = split(/,/, $args );
 
789
    my @argtypes  = split(/,/, $mpi_routines{$routine}[0]);
 
790
    my @argnames  = split(/,/, $mpi_routines{$routine}[1]);
762
791
 
763
 
    print MPIFD "        SUBROUTINE ${out_prefix}${ucname}_T(";
764
 
    for ($i=0; $i<=$#parms; $i++) {
765
 
        print MPIFD "v$i,";
766
 
    }
767
 
    print MPIFD "ierror)\n";
 
792
    print MPIFD "      SUBROUTINE ${out_prefix}${ucname}_T";
 
793
    &PrintArgBrace(MPIFD,
 
794
         length("      SUBROUTINE ${out_prefix}${ucname}_T"),
 
795
         length("      SUBROUTINE  "),
 
796
         $line_limit,
 
797
         @argnames);
768
798
 
769
799
    if (defined($NeedConstants{$routine})) {
770
 
        print MPIFD "       USE ${out_prefix}CONSTANTS,ONLY:";
771
 
        $sep = "";
772
 
        foreach $name (split(/\s+/,$NeedConstants{$routine})) {
773
 
            print MPIFD "$sep$name";
774
 
            $sep = ", ";
775
 
        }
776
 
        print MPIFD "\n";
 
800
        print MPIFD "      USE ${out_prefix}CONSTANTS,ONLY:";
 
801
        $sep = "";
 
802
        foreach $name (split(/\s+/,$NeedConstants{$routine})) {
 
803
            print MPIFD "$sep$name";
 
804
            $sep = ", ";
 
805
        }
 
806
        print MPIFD "\n";
777
807
    }
778
808
 
779
809
    # print the arg decls ...
780
810
    # convert %type% to the various types and %dims% to the dimensions,
781
811
    # including scalar.
782
812
    $nchoice = 0;
783
 
    for ($i=0; $i<=$#parms; $i++) {
784
 
        $parms[$i] =~ s/^const\s//;  # Remove const if present
785
 
        $parm = $parms[$i];
786
 
        # Check for special args
787
 
        $loc = $i+1;
788
 
        if (defined($special_args{"$routine-$loc"})) {
789
 
            $parm = $special_args{"$routine-$loc"};
790
 
        }
 
813
    for ($i=0; $i<=$#argtypes; $i++) {
 
814
        $argtypes[$i] =~ s/^const\s//;  # Remove const if present
 
815
        $argtype = $argtypes[$i];
 
816
        # Check for special args
 
817
        $loc = $i+1;
 
818
        if (defined($special_args{"$routine-$loc"})) {
 
819
            $argtype = $special_args{"$routine-$loc"};
 
820
        }
791
821
 
792
 
        if ($parm =~ /void/) {
793
 
            # An alternative to this is to have a separate file for
794
 
            # routines with 2 choice arguments
795
 
            if ($nchoice == 0) {
796
 
                print MPIFD "        <type> v$i<dims>\n";
797
 
            }
798
 
            else {
799
 
                print MPIFD "        <type$nchoice> v$i<dims$nchoice>\n";
800
 
            }
801
 
            $nchoice ++;
802
 
        }
803
 
        else {
804
 
            # Map the C type to the Fortran type
805
 
            $cparm = $parm;
806
 
            $cparm =~ s/\s+//g;
807
 
            $fparm = $parmc2f{$cparm};
808
 
            if ($fparm eq "") {
809
 
                print STDERR "$routine: No parm type for $cparm ($parm)\n";
810
 
            }
811
 
            if ($fparm =~ /%name%/) {
812
 
                $fparm =~ s/%name%/v$i/;
813
 
                # In the name case, convert any %nl% to newlines and spaces
814
 
                $fparm =~ s/%nl%/\n       /g;
815
 
                print MPIFD "        $fparm\n";
816
 
            }
817
 
            else {
818
 
                print MPIFD "        $fparm v$i\n";
819
 
            }
820
 
        }
 
822
        if ($argtype =~ /void/) {
 
823
            # An alternative to this is to have a separate file for
 
824
            # routines with 2 choice arguments
 
825
            if ($nchoice == 0) {
 
826
                print MPIFD "        <type> $argnames[$i]<dims>\n";
 
827
            }
 
828
            else {
 
829
                print MPIFD "        <type$nchoice> $argnames[$i]<dims$nchoice>\n";
 
830
            }
 
831
            $nchoice ++;
 
832
        }
 
833
        else {
 
834
            # Map the C type to the Fortran type
 
835
            $cargtype = $argtype;
 
836
            $cargtype =~ s/\s+//g;
 
837
            $fargtype = $argtypec2f{$cargtype};
 
838
            if ($fargtype eq "") {
 
839
                print STDERR "$routine: No Fortran type for $cargtype ($argtype)\n";
 
840
            }
 
841
            if ($fargtype =~ /%name%/) {
 
842
                $fargtype =~ s/%name%/$argnames[$i]/;
 
843
                # In the name case, convert any %nl% to newlines and spaces
 
844
                $fargtype =~ s/%nl%/\n       /g;
 
845
                print MPIFD "        $fargtype\n";
 
846
            }
 
847
            else {
 
848
                print MPIFD "        $fargtype $argnames[$i]\n";
 
849
            }
 
850
        }
821
851
    }
822
 
    print MPIFD "        INTEGER ierror\n";
 
852
 
823
853
    print MPIFD "        EXTERNAL ${out_prefix}${ucname}\n";
824
 
    print MPIFD "        CALL ${out_prefix}${ucname}(";
825
 
    for ($i=0; $i<=$#parms; $i++) {
826
 
        print MPIFD "v$i,";
827
 
    }
828
 
    print MPIFD "ierror)\n";
829
 
    print MPIFD "        END SUBROUTINE ${out_prefix}${ucname}_T\n\n";
 
854
    print MPIFD "        CALL ${out_prefix}${ucname}";
 
855
    &PrintArgBrace(MPIFD,
 
856
        length("              CALL ${out_prefix}${ucname}"),
 
857
        length("              CALL  "),
 
858
        $line_limit,
 
859
        @argnames);
 
860
 
 
861
    print MPIFD "      END SUBROUTINE ${out_prefix}${ucname}_T\n\n";
830
862
}
831
863
 
832
864
# The base sizeof's are handled separately now in their own file
833
865
 
834
 
print MPIFD "        END MODULE ${ucoutfile_prefix}_t1_s\n";
 
866
print MPIFD "      END MODULE ${ucoutfile_prefix}_t1_s\n";
835
867
close MPIFD;
836
868
&ReplaceIfDifferent( "${outfile_prefix}_t1.f90", "${outfile_prefix}_t1.f90.new" );
837
869
 
875
907
\$(top_srcdir)/src/binding/f90/Makefile.mk: src/binding/f90/buildiface-stamp
876
908
 
877
909
src/binding/f90/buildiface-stamp: \$(top_srcdir)/src/binding/f90/buildiface \$(top_srcdir)/src/include/mpi.h.in
878
 
        ( cd \$(top_srcdir)/src/binding/f90 && ./buildiface )
 
910
\t( cd \$(top_srcdir)/src/binding/f90 && ./buildiface )
879
911
endif MAINTAINER_MODE
880
912
 
881
913
# variables for custom "silent-rules" for F90 modules
890
922
# in a VPATH build)
891
923
AM_FCFLAGS += \@FCINCFLAG\@src/binding/f90
892
924
 
893
 
lib_LTLIBRARIES += lib/lib\@MPILIBNAME\@f90.la
 
925
lib_LTLIBRARIES += lib/lib\@FCWRAPNAME\@.la
894
926
 
895
927
EOT
896
928
 
922
954
    src/binding/f90/mpif90model.h
923
955
 
924
956
# actual f90 code that also gets compiled into modules
925
 
lib_lib\@MPILIBNAME\@f90_la_LDFLAGS = \$(ABIVERSIONFLAGS)
 
957
lib_lib\@FCWRAPNAME\@_la_LDFLAGS = \$(ABIVERSIONFLAGS)
926
958
 
927
959
# cause any .\$(MOD) files to be output in the f90 bindings directory instead of
928
960
# the current directory
929
961
AM_FCFLAGS += \$(FCMODOUTFLAG)src/binding/f90
930
962
 
931
963
# we "manually" build the f90 sources and add them with LIBADD
932
 
lib_lib\@MPILIBNAME\@f90_la_SOURCES =
933
 
lib_lib\@MPILIBNAME\@f90_la_LIBADD = \\
 
964
lib_lib\@FCWRAPNAME\@_la_SOURCES =
 
965
lib_lib\@FCWRAPNAME\@_la_LIBADD = \\
934
966
    src/binding/f90/mpi.lo \\
935
967
    src/binding/f90/mpi_constants.lo \\
936
968
    src/binding/f90/mpi_sizeofs.lo \\
937
969
    src/binding/f90/${outfile_prefix}_base.lo
938
970
 
939
971
# now force libtool FC rules/variables to be generated and cause FC linking to
940
 
# be selected for lib/lib\@MPILIBNAME\@f90.la
941
 
EXTRA_lib_lib\@MPILIBNAME\@f90_la_SOURCES = \\
 
972
# be selected for lib/lib\@FCWRAPNAME\@.la
 
973
EXTRA_lib_lib\@FCWRAPNAME\@_la_SOURCES = \\
942
974
    src/binding/f90/mpi.f90 \\
943
975
    src/binding/f90/mpi_constants.f90
944
976
 
945
 
nodist_EXTRA_lib_lib\@MPILIBNAME\@f90_la_SOURCES = \\
 
977
nodist_EXTRA_lib_lib\@FCWRAPNAME\@_la_SOURCES = \\
946
978
    src/binding/f90/mpi_sizeofs.f90 \\
947
979
    src/binding/f90/${outfile_prefix}_base.f90
948
980
 
950
982
 
951
983
print MAKEFD <<EOT;
952
984
# FIXME: We may want to edit the mpif.h to convert Fortran77-specific
953
 
# items (such as an integer*8 used for file offsets) into the 
 
985
# items (such as an integer*8 used for file offsets) into the
954
986
# corresponding Fortran 90 KIND type, to accomodate compilers that
955
987
# reject non-standard features such as integer*8 (such as the Intel
956
988
# Fortran compiler with -std95).
1008
1040
    src/binding/f90/\$(MPIBASEMOD).\$(MOD)
1009
1041
 
1010
1042
# the modules are effectively precompiled headers for Fortran programs
1011
 
include_HEADERS += \$(mpi_f90_modules)
 
1043
modinc_HEADERS = \$(mpi_f90_modules)
1012
1044
 
1013
1045
# We need a free-format version of mpif.h with no external commands,
1014
 
# including no wtime/wtick (removing MPI_WTICK also removes MPI_WTIME, 
 
1046
# including no wtime/wtick (removing MPI_WTICK also removes MPI_WTIME,
1015
1047
# but leave MPI_WTIME_IS_GLOBAL).
1016
 
# Also allow REAL*8 or DOUBLE PRECISION for the MPI_WTIME/MPI_WTICK 
 
1048
# Also allow REAL*8 or DOUBLE PRECISION for the MPI_WTIME/MPI_WTICK
1017
1049
# declarations
1018
1050
src/binding/f90/mpifnoext.h: src/binding/f77/mpif.h
1019
 
        rm -f \$@
1020
 
        sed -e 's/^C/\\!/g' -e '/EXTERNAL/d' \\
1021
 
                -e '/REAL\\*8/d' \\
1022
 
                -e '/DOUBLE PRECISION/d' \\
1023
 
                -e '/MPI_WTICK/d' src/binding/f77/mpif.h > \$@
 
1051
\trm -f \$@
 
1052
\tsed -e 's/^C/\\!/g' -e '/EXTERNAL/d' \\
 
1053
\t-e '/REAL\\*8/d' \\
 
1054
\t-e '/DOUBLE PRECISION/d' \\
 
1055
\t-e '/MPI_WTICK/d' src/binding/f77/mpif.h > \$@
1024
1056
 
1025
1057
CLEANFILES += src/binding/f90/mpifnoext.h
1026
1058
 
1047
1079
 
1048
1080
# ----------------------------------------------------------------------------
1049
1081
# FIXME: Add the steps to handle the choice arguments.  They should be
1050
 
# selected by configure from a list of possible choices, with an 
1051
 
# enable switch used to bypass the checks.  In addition, we need a way to 
1052
 
# dynamically create subsets, given a list of routines and types/dimensions 
 
1082
# selected by configure from a list of possible choices, with an
 
1083
# enable switch used to bypass the checks.  In addition, we need a way to
 
1084
# dynamically create subsets, given a list of routines and types/dimensions
1053
1085
# to include.  This allows users to build precisely tailored Fortran90 modules.
1054
1086
# ----------------------------------------------------------------------------
1055
1087
 
1077
1109
    my $count = $_[2];
1078
1110
    my $continue = $_[3];
1079
1111
    my $continue_len = $_[4];
1080
 
    
 
1112
 
1081
1113
    $linelen = length( $line );
1082
1114
    #print "linelen = $linelen, print_line_len = $print_line_len\n";
1083
1115
    if ($print_line_len + $linelen > $count) {
1084
 
        print $FD $continue;
1085
 
        $print_line_len = $continue_len;
 
1116
    print $FD $continue;
 
1117
    $print_line_len = $continue_len;
1086
1118
    }
1087
1119
    print $FD $line;
1088
1120
    $print_line_len += $linelen;
1101
1133
# config.status.
1102
1134
sub createModSteps {
1103
1135
    my ($module, $deps, $srcFile, $use_srcdir) = @_;
1104
 
    
 
1136
 
1105
1137
    # Get a version of the source file with $(FCEXT) instead of .f90
1106
1138
    # as the extension
1107
1139
    my $srcFileWithExt = $srcFile;
1128
1160
 
1129
1161
    # Attempt to deal with Fortran module files in a mostly sane way.  Quick
1130
1162
    # overview for the less Fortran literate:
1131
 
    # 
 
1163
    #
1132
1164
    # MPICH has four Fortran modules: mpi, mpi_constants, mpi_sizeofs, and
1133
1165
    # mpi_base.  Each module is produced as a side effect of compiling the
1134
1166
    # corresponding .f90 file into a .lo.  The .lo is produced by libtool and is
1211
1243
 
1212
1244
}
1213
1245
 
1214
 
# Print the declarations for the given routine.  
 
1246
# Print arguments in a pair of braces and end with a new line.
 
1247
# $fd : File handle to print to.
 
1248
# $curlen : Length of the current line.
 
1249
# $indent : Indention length of the following lines when they exist.
 
1250
# $line_length : Maximal length of a line.
 
1251
# @argnames : argument names to print out.
 
1252
sub PrintArgBrace {
 
1253
    my ($fd, $curlen, $indent, $line_length, @argnames) = @_;
 
1254
    my $i = 0;
 
1255
 
 
1256
    print $fd "(";
 
1257
    $curlen++;
 
1258
    foreach my $arg (@argnames) {
 
1259
        if ($curlen + length($arg) + 2 > $line_length) { # + 2 for the trailing ',&'
 
1260
            $curlen = $indent;
 
1261
            print $fd "&\n";
 
1262
            print $fd " " x $indent;
 
1263
            print $fd "$arg";
 
1264
        } else {
 
1265
            print $fd "$arg";
 
1266
        }
 
1267
 
 
1268
        if ($i++ < $#argnames) {
 
1269
            print $fd ",";
 
1270
        }
 
1271
 
 
1272
        $curlen += length($arg) + 1;
 
1273
    }
 
1274
 
 
1275
    print $fd ")\n";
 
1276
}
 
1277
 
 
1278
# Print the declarations for the given routine.
1215
1279
sub PrintArgDecls {
1216
1280
    my ($routine,$svflag,$svArgs) = @_;
1217
1281
 
1218
1282
    my $ucname = uc($routine);
1219
 
    my $args   = $mpi_routines{$routine};
1220
 
    my @parms  = split(/,/, $args );
1221
 
 
1222
 
    # preload the svargs if requested.  This is used to decide whether 
 
1283
    my @argtypes = split(/,/, $mpi_routines{$routine}[0]);
 
1284
    my @argnames = split(/,/, $mpi_routines{$routine}[1]);
 
1285
 
 
1286
    print "Printing argument delartion for $ucname\n" if $gDebug;
 
1287
    print "argtypes = $mpi_routines{$routine}[0]\n" if $gDebug;
 
1288
    print "argnames = $mpi_routines{$routine}[1]\n" if $gDebug;
 
1289
 
 
1290
    # preload the svargs if requested.  This is used to decide whether
1223
1291
    # an array arg is output as a scalar or a vector
1224
1292
    my %svargs = ();
1225
1293
    if ($svflag) {
1226
 
        for my $val (split(/:/,$svArgs)) {
1227
 
            my $loc = $val;
1228
 
            my $count = "-1";
1229
 
            if ($loc =~ /(\d+)-(\d+)/) {
1230
 
                $loc   = $1;
1231
 
                $count = $2;
1232
 
            }
1233
 
            $svargs{$loc} = $count;
1234
 
        }
1235
 
    }
1236
 
    # Determine if we need any constants (e.g., MPI_STATUS_SIZE, 
 
1294
    for my $val (split(/:/,$svArgs)) {
 
1295
        my $loc = $val;
 
1296
        my $count = "-1";
 
1297
        if ($loc =~ /(\d+)-(\d+)/) {
 
1298
        $loc   = $1;
 
1299
        $count = $2;
 
1300
        }
 
1301
        $svargs{$loc} = $count;
 
1302
    }
 
1303
    }
 
1304
    # Determine if we need any constants (e.g., MPI_STATUS_SIZE,
1237
1305
    # MPI_OFFSET_KIND)
1238
1306
    my %use_constants = ();
1239
1307
    my $found_constants = 0;
1240
 
    for (my $i=0; $i<=$#parms; $i++) {
1241
 
        $parms[$i] =~ s/^const\s+//;  # Remove const if present
1242
 
        $parm = $parms[$i];
1243
 
        # Check for special args
1244
 
        $loc = $i+1;
1245
 
        if (defined($special_args{"$routine-$loc"})) {
1246
 
            $parm = $special_args{"$routine-$loc"};
1247
 
        }
1248
 
        # Map the C type to the Fortran type
1249
 
        $cparm = $parm;
1250
 
        $cparm =~ s/\s+//g;
1251
 
        $fparm = $parmc2f{$cparm};
1252
 
        # Now, does this type contain an MPI constant?
1253
 
        if (!defined($fparm)) {
1254
 
            print "$cparm value has no matching fortran parm\n";
1255
 
        }
1256
 
        if ($fparm =~ /(MPI_[A-Z_]*)/) {
1257
 
            $use_constants{$1} = 1;
1258
 
            $found_constants = 1;
1259
 
        }
 
1308
    for (my $i=0; $i<=$#argtypes; $i++) {
 
1309
    $argtypes[$i] =~ s/^const\s+//;  # Remove const if present
 
1310
    my $argtype = $argtypes[$i];
 
1311
    # Check for special args
 
1312
    $loc = $i+1;
 
1313
    if (defined($special_args{"$routine-$loc"})) {
 
1314
        $argtype = $special_args{"$routine-$loc"};
 
1315
    }
 
1316
    # Map the C type to the Fortran type
 
1317
    my $cargtype = $argtype;
 
1318
    $cargtype =~ s/\s+//g;
 
1319
    my $fargtype = $argtypec2f{$cargtype};
 
1320
    # Now, does this type contain an MPI constant?
 
1321
    if (!defined($fargtype)) {
 
1322
        print "$cargtype value has no matching fortran argtype\n";
 
1323
    }
 
1324
    if ($fargtype =~ /(MPI_[A-Z_]*)/) {
 
1325
        $use_constants{$1} = 1;
 
1326
        $found_constants = 1;
 
1327
    }
1260
1328
    }
1261
1329
    if ($found_constants) {
1262
 
        print MPIBASEFD "       USE MPI_CONSTANTS,ONLY:";
1263
 
        $sep = "";
1264
 
        foreach $name (keys(%use_constants)) {
1265
 
            print MPIBASEFD "$sep$name";
1266
 
            $sep = ", ";
1267
 
            $NeedConstants{$routine} .= "$name ";
1268
 
        }
1269
 
        print MPIBASEFD "\n";
 
1330
        print MPIBASEFD "           USE MPI_CONSTANTS,ONLY:";
 
1331
        $sep = "";
 
1332
        foreach $name (keys(%use_constants)) {
 
1333
            print MPIBASEFD "$sep$name";
 
1334
            $sep = ", ";
 
1335
            $NeedConstants{$routine} .= "$name ";
 
1336
        }
 
1337
        print MPIBASEFD "\n";
1270
1338
    }
1271
1339
 
1272
1340
    # Output argument types
1273
 
    $lastParmType = "<none>";
1274
 
    for (my $i=0; $i<=$#parms; $i++) {
1275
 
        $parm = $parms[$i];
1276
 
        # Check for special args
1277
 
        $loc = $i+1;
1278
 
        if (defined($special_args{"$routine-$loc"})) {
1279
 
            $parm = $special_args{"$routine-$loc"};
1280
 
        }
1281
 
        # Map the C type to the Fortran type
1282
 
        $cparm = $parm;
1283
 
        $cparm =~ s/\s+//g;
1284
 
        $fparm = $parmc2f{$cparm};
1285
 
        if ($fparm eq "") {
1286
 
            print STDERR "$routine: No parm type for $cparm ($parm)\n";
1287
 
        }
1288
 
        # Split out the base type from the name
1289
 
        if ($fparm =~ /(\w+.*)\s+(%name\S.*)/) {
1290
 
            $parmType = $1;
1291
 
            $varName  = $2;
1292
 
            if ($varName =~ /%name%/) {
1293
 
                $varName =~ s/%name%/v$i/;
1294
 
            }
1295
 
            $varName =~ s/%nl%/\n       /g;
1296
 
            $parmType =~ s/%nl%/\n       /g;
1297
 
 
1298
 
            # Here's where we might change vector to scalar args
1299
 
            if ($svflag) {
1300
 
                if (defined($svargs{$loc})) {
1301
 
                    # The value is the count arg for the array; later, we
1302
 
                    # can make use of that to improve the definitions
1303
 
                    if ($varName =~ /,\*/) {
1304
 
                        $varName =~ s/,\*//;
1305
 
                    }
1306
 
                    elsif ($varName =~ /\(\*\)/) {
1307
 
                        $varName =~ s/\(\*\)//;
1308
 
                    }
1309
 
                    else {
1310
 
                        print STDERR "Failed to make arg $i in $routine a scalar\n";
1311
 
                    }
1312
 
                }
1313
 
            }
1314
 
        }
1315
 
        else {
1316
 
            $parmType = $fparm;
1317
 
            $varName  = "v$i";
1318
 
        }
1319
 
        if ($parmType ne $lastParmType) {
1320
 
            if ($lastParmType ne "<none>" ) { print MPIBASEFD "\n"; }
1321
 
            print MPIBASEFD "       $parmType $varName";
1322
 
            $lastParmType = $parmType;
1323
 
        }
1324
 
        else {
1325
 
            print MPIBASEFD ", $varName";
1326
 
        }
 
1341
    for (my $i=0; $i<=$#argtypes; $i++) {
 
1342
        $argtype = $argtypes[$i];
 
1343
        # Check for special args
 
1344
        $loc = $i+1;
 
1345
        if (defined($special_args{"$routine-$loc"})) {
 
1346
            $argtype = $special_args{"$routine-$loc"};
 
1347
        }
 
1348
        # Map the C type to the Fortran type
 
1349
        $cargtype = $argtype;
 
1350
        $cargtype =~ s/\s+//g;
 
1351
        $fargtype = $argtypec2f{$cargtype};
 
1352
        if ($fargtype eq "") {
 
1353
            print STDERR "$routine: No Fortran type for $cargtype ($argtype)\n";
 
1354
        }
 
1355
        # Split out the base type from the name
 
1356
        if ($fargtype =~ /(\w+.*)\s+(%name\S.*)/) {
 
1357
            $varType = $1;
 
1358
            $varName  = $2;
 
1359
            if ($varName =~ /%name%/) {
 
1360
            $varName =~ s/%name%/$argnames[$i]/;
 
1361
            }
 
1362
            $varName =~ s/%nl%/\n       /g;
 
1363
            $varType =~ s/%nl%/\n       /g;
 
1364
 
 
1365
            # Here's where we might change vector to scalar args
 
1366
            if ($svflag) {
 
1367
                if (defined($svargs{$loc})) {
 
1368
                    # The value is the count arg for the array; later, we
 
1369
                    # can make use of that to improve the definitions
 
1370
                    if ($varName =~ /,\*/) {
 
1371
                        $varName =~ s/,\*//;
 
1372
                    }
 
1373
                    elsif ($varName =~ /\(\*\)/) {
 
1374
                        $varName =~ s/\(\*\)//;
 
1375
                    }
 
1376
                    else {
 
1377
                        print STDERR "Failed to make arg $i in $routine a scalar\n";
 
1378
                    }
 
1379
                }
 
1380
            }
 
1381
         }
 
1382
         else {
 
1383
            $varType = $fargtype;
 
1384
            $varName = $argnames[$i];
 
1385
         }
 
1386
 
 
1387
         print MPIBASEFD "           $varType $varName\n";
1327
1388
    }
1328
 
    if ($lastParmType ne "<none>" ) { print MPIBASEFD "\n"; }
1329
 
 
1330
 
    print MPIBASEFD "       INTEGER ierror\n";
1331
1389
}
1332
1390
 
1333
1391
#
1334
1392
# Replace old file with new file only if new file is different
1335
 
# Otherwise, remove new filename 
 
1393
# Otherwise, remove new filename
1336
1394
sub ReplaceIfDifferent {
1337
1395
    my ($oldfilename,$newfilename) = @_;
1338
1396
    my $rc = 1;
1339
 
    if (-s $oldfilename) { 
1340
 
        $rc = system "cmp -s $newfilename $oldfilename";
1341
 
        $rc >>= 8;   # Shift right to get exit status
 
1397
    if (-s $oldfilename) {
 
1398
        $rc = system "cmp -s $newfilename $oldfilename";
 
1399
        $rc >>= 8;   # Shift right to get exit status
1342
1400
    }
1343
1401
    if ($rc != 0) {
1344
 
        # The files differ.  Replace the old file 
1345
 
        # with the new one
1346
 
        if (-s $oldfilename) {
1347
 
            print STDERR "Replacing $oldfilename\n";
1348
 
            # If debugging and there is a difference, show that difference
1349
 
            if ($gDebug) { system "diff $newfilename $oldfilename"; }
 
1402
    # The files differ.  Replace the old file
 
1403
    # with the new one
 
1404
    if (-s $oldfilename) {
 
1405
        print STDERR "Replacing $oldfilename\n";
 
1406
        # If debugging and there is a difference, show that difference
 
1407
        if ($gDebug) { system "diff $newfilename $oldfilename"; }
1350
1408
 
1351
 
            unlink $oldfilename;
1352
 
        }
1353
 
        else {
1354
 
            print STDERR "Creating $oldfilename\n";
1355
 
        }
1356
 
        rename $newfilename, $oldfilename || 
1357
 
            die "Could not replace $oldfilename";
1358
 
    }
1359
 
    else {
1360
 
        unlink $newfilename;
 
1409
        unlink $oldfilename;
 
1410
    }
 
1411
    else {
 
1412
        print STDERR "Creating $oldfilename\n";
 
1413
    }
 
1414
    rename $newfilename, $oldfilename ||
 
1415
        die "Could not replace $oldfilename";
 
1416
    }
 
1417
    else {
 
1418
        unlink $newfilename;
1361
1419
    }
1362
1420
}