1 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
2 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
3 | !----------------------------------------------------------------------- |
---|
4 | ! CVS m_mpif90.F90,v 1.3 2002-08-22 23:14:52 jacob Exp |
---|
5 | ! CVS MCT_2_8_0 |
---|
6 | !----------------------------------------------------------------------- |
---|
7 | !BOP |
---|
8 | ! |
---|
9 | ! !MODULE: m_mpif90 - a Fortran 90 style MPI module interface. |
---|
10 | ! |
---|
11 | ! !DESCRIPTION: |
---|
12 | ! |
---|
13 | ! By wrapping \verb'include "mpif.h"' into a module, \verb"m_mpif()" |
---|
14 | ! provides an easy way to |
---|
15 | !\begin{itemize} |
---|
16 | ! \item avoid the problem with {\sl fixed} or {\sl free} formatted |
---|
17 | ! Fortran 90 files; |
---|
18 | ! \item provide protections with only a limited set of \verb"PUBLIC" |
---|
19 | ! variables; and |
---|
20 | ! \item be extended to a MPI Fortran 90 binding. |
---|
21 | !\end{itemize} |
---|
22 | ! |
---|
23 | ! !INTERFACE: |
---|
24 | |
---|
25 | module m_mpif90 |
---|
26 | use m_mpif, only : MP_INTEGER => MPI_INTEGER |
---|
27 | use m_mpif, only : MP_REAL => MPI_REAL |
---|
28 | use m_mpif, only : MP_DOUBLE_PRECISION & |
---|
29 | => MPI_DOUBLE_PRECISION |
---|
30 | use m_mpif, only : MP_LOGICAL => MPI_LOGICAL |
---|
31 | use m_mpif, only : MP_CHARACTER => MPI_CHARACTER |
---|
32 | |
---|
33 | use m_mpif, only : MP_REAL4 => MPI_REAL4 |
---|
34 | use m_mpif, only : MP_REAL8 => MPI_REAL8 |
---|
35 | |
---|
36 | use m_mpif, only : MP_COMM_WORLD => MPI_COMM_WORLD |
---|
37 | use m_mpif, only : MP_COMM_NULL => MPI_COMM_NULL |
---|
38 | use m_mpif, only : MP_SUM => MPI_SUM |
---|
39 | use m_mpif, only : MP_PROD => MPI_PROD |
---|
40 | use m_mpif, only : MP_MIN => MPI_MIN |
---|
41 | use m_mpif, only : MP_MAX => MPI_MAX |
---|
42 | use m_mpif, only : MP_MAX_ERROR_STRING & |
---|
43 | => MPI_MAX_ERROR_STRING |
---|
44 | use m_mpif, only : MP_STATUS_SIZE => MPI_STATUS_SIZE |
---|
45 | use m_mpif, only : MP_ANY_SOURCE => MPI_ANY_SOURCE |
---|
46 | |
---|
47 | implicit none |
---|
48 | private |
---|
49 | |
---|
50 | public :: MP_type |
---|
51 | |
---|
52 | public :: MP_INTEGER |
---|
53 | public :: MP_REAL |
---|
54 | public :: MP_DOUBLE_PRECISION |
---|
55 | public :: MP_LOGICAL |
---|
56 | public :: MP_CHARACTER |
---|
57 | |
---|
58 | public :: MP_REAL4 |
---|
59 | public :: MP_REAL8 |
---|
60 | |
---|
61 | public :: MP_COMM_WORLD |
---|
62 | public :: MP_COMM_NULL |
---|
63 | |
---|
64 | public :: MP_SUM |
---|
65 | public :: MP_PROD |
---|
66 | public :: MP_MIN |
---|
67 | public :: MP_MAX |
---|
68 | |
---|
69 | public :: MP_ANY_SOURCE |
---|
70 | |
---|
71 | public :: MP_MAX_ERROR_STRING |
---|
72 | |
---|
73 | public :: MP_init |
---|
74 | public :: MP_initialized |
---|
75 | public :: MP_finalize |
---|
76 | public :: MP_abort |
---|
77 | |
---|
78 | public :: MP_wtime |
---|
79 | public :: MP_wtick |
---|
80 | |
---|
81 | public :: MP_comm_size |
---|
82 | public :: MP_comm_rank |
---|
83 | public :: MP_comm_dup |
---|
84 | public :: MP_comm_free |
---|
85 | |
---|
86 | public :: MP_cart_create |
---|
87 | public :: MP_dims_create |
---|
88 | public :: MP_cart_coords |
---|
89 | public :: MP_cart_rank |
---|
90 | |
---|
91 | public :: MP_error_string |
---|
92 | |
---|
93 | public :: MP_perr |
---|
94 | |
---|
95 | public :: MP_STATUS_SIZE |
---|
96 | public :: MP_status |
---|
97 | |
---|
98 | public :: MP_log2 |
---|
99 | |
---|
100 | ! !REVISION HISTORY: |
---|
101 | ! 09Dec97 - Jing Guo <guo@thunder> - initial prototyping/coding. |
---|
102 | ! . started with everything public, without any interface |
---|
103 | ! declaration. |
---|
104 | ! . Then limited to only variables current expected to |
---|
105 | ! be used. |
---|
106 | ! |
---|
107 | !EOP |
---|
108 | !_______________________________________________________________________ |
---|
109 | |
---|
110 | integer,dimension(MP_STATUS_SIZE) :: MP_status |
---|
111 | |
---|
112 | !---------------------------------------- |
---|
113 | |
---|
114 | interface MP_init |
---|
115 | subroutine MPI_init(ier) |
---|
116 | integer,intent(out) :: ier |
---|
117 | end subroutine MPI_init |
---|
118 | end interface |
---|
119 | |
---|
120 | interface MP_initialized |
---|
121 | subroutine MPI_initialized(flag,ier) |
---|
122 | logical,intent(out) :: flag |
---|
123 | integer,intent(out) :: ier |
---|
124 | end subroutine MPI_initialized |
---|
125 | end interface |
---|
126 | |
---|
127 | interface MP_finalize |
---|
128 | subroutine MPI_finalize(ier) |
---|
129 | integer,intent(out) :: ier |
---|
130 | end subroutine MPI_finalize |
---|
131 | end interface |
---|
132 | |
---|
133 | interface MP_error_string |
---|
134 | subroutine MPI_error_string(ierror,cerror,ln,ier) |
---|
135 | integer,intent(in) :: ierror |
---|
136 | character(len=*),intent(out) :: cerror |
---|
137 | integer,intent(out) :: ln |
---|
138 | integer,intent(out) :: ier |
---|
139 | end subroutine MPI_error_string |
---|
140 | end interface |
---|
141 | |
---|
142 | interface MP_type; module procedure & |
---|
143 | typeI_, & ! MPI_INTEGER |
---|
144 | typeL_, & ! MPI_LOGICAL |
---|
145 | typeC_, & ! MPI_CHARACTER |
---|
146 | typeSP_, & ! MPI_REAL |
---|
147 | typeDP_, & ! MPI_DOUBLE_PRECISION |
---|
148 | typeI1_, & ! MPI_INTEGER |
---|
149 | typeL1_, & ! MPI_LOGICAL |
---|
150 | typeC1_, & ! MPI_CHARACTER |
---|
151 | typeSP1_, & ! MPI_REAL |
---|
152 | typeDP1_, & ! MPI_DOUBLE_PRECISION |
---|
153 | typeI2_, & ! MPI_INTEGER |
---|
154 | typeL2_, & ! MPI_LOGICAL |
---|
155 | typeC2_, & ! MPI_CHARACTER |
---|
156 | typeSP2_, & ! MPI_REAL |
---|
157 | typeDP2_ ! MPI_DOUBLE_PRECISION |
---|
158 | end interface |
---|
159 | |
---|
160 | interface MP_perr; module procedure perr_; end interface |
---|
161 | |
---|
162 | interface MP_abort |
---|
163 | subroutine MPI_abort(comm,errorcode,ier) |
---|
164 | integer,intent(in) :: comm |
---|
165 | integer,intent(in) :: errorcode |
---|
166 | integer,intent(out) :: ier |
---|
167 | end subroutine MPI_abort |
---|
168 | end interface |
---|
169 | |
---|
170 | !---------------------------------------- |
---|
171 | interface MP_wtime |
---|
172 | function MPI_wtime() |
---|
173 | double precision :: MPI_wtime |
---|
174 | end function MPI_wtime |
---|
175 | end interface |
---|
176 | |
---|
177 | interface MP_wtick |
---|
178 | function MPI_wtick() |
---|
179 | double precision :: MPI_wtick |
---|
180 | end function MPI_wtick |
---|
181 | end interface |
---|
182 | |
---|
183 | !---------------------------------------- |
---|
184 | interface MP_comm_size |
---|
185 | subroutine MPI_comm_size(comm,size,ier) |
---|
186 | integer,intent(in) :: comm |
---|
187 | integer,intent(out) :: size |
---|
188 | integer,intent(out) :: ier |
---|
189 | end subroutine MPI_comm_size |
---|
190 | end interface |
---|
191 | |
---|
192 | interface MP_comm_rank |
---|
193 | subroutine MPI_comm_rank(comm,rank,ier) |
---|
194 | integer,intent(in) :: comm |
---|
195 | integer,intent(out) :: rank |
---|
196 | integer,intent(out) :: ier |
---|
197 | end subroutine MPI_comm_rank |
---|
198 | end interface |
---|
199 | |
---|
200 | interface MP_comm_dup |
---|
201 | subroutine MPI_comm_dup(comm,newcomm,ier) |
---|
202 | integer,intent(in) :: comm |
---|
203 | integer,intent(out) :: newcomm |
---|
204 | integer,intent(out) :: ier |
---|
205 | end subroutine MPI_comm_dup |
---|
206 | end interface |
---|
207 | |
---|
208 | interface MP_comm_free |
---|
209 | subroutine MPI_comm_free(comm,ier) |
---|
210 | integer,intent(inout) :: comm |
---|
211 | integer,intent(out) :: ier |
---|
212 | end subroutine MPI_comm_free |
---|
213 | end interface |
---|
214 | |
---|
215 | !---------------------------------------- |
---|
216 | interface MP_cart_create |
---|
217 | subroutine MPI_cart_create(comm_old,ndims,dims,periods, & |
---|
218 | reorder,comm_cart,ier) |
---|
219 | integer,intent(in) :: comm_old |
---|
220 | integer,intent(in) :: ndims |
---|
221 | integer,dimension(*),intent(in) :: dims |
---|
222 | logical,dimension(*),intent(in) :: periods |
---|
223 | logical, intent(in) :: reorder |
---|
224 | integer,intent(out) :: comm_cart |
---|
225 | integer,intent(out) :: ier |
---|
226 | end subroutine MPI_cart_create |
---|
227 | end interface |
---|
228 | |
---|
229 | interface MP_dims_create |
---|
230 | subroutine MPI_dims_create(nnodes,ndims,dims,ier) |
---|
231 | integer,intent(in) :: nnodes |
---|
232 | integer,intent(in) :: ndims |
---|
233 | integer,dimension(*),intent(inout) :: dims |
---|
234 | integer,intent(out) :: ier |
---|
235 | end subroutine MPI_dims_create |
---|
236 | end interface |
---|
237 | |
---|
238 | interface MP_cart_coords |
---|
239 | subroutine MPI_cart_coords(comm,rank,maxdims,coords,ier) |
---|
240 | integer,intent(in) :: comm |
---|
241 | integer,intent(in) :: rank |
---|
242 | integer,intent(in) :: maxdims |
---|
243 | integer,dimension(*),intent(out) :: coords |
---|
244 | integer,intent(out) :: ier |
---|
245 | end subroutine MPI_cart_coords |
---|
246 | end interface |
---|
247 | |
---|
248 | interface MP_cart_rank |
---|
249 | subroutine MPI_cart_rank(comm,coords,rank,ier) |
---|
250 | integer,intent(in) :: comm |
---|
251 | integer,dimension(*),intent(in) :: coords |
---|
252 | integer,intent(out) :: rank |
---|
253 | integer,intent(out) :: ier |
---|
254 | end subroutine MPI_cart_rank |
---|
255 | end interface |
---|
256 | !---------------------------------------- |
---|
257 | |
---|
258 | character(len=*),parameter :: myname='m_mpif90' |
---|
259 | contains |
---|
260 | |
---|
261 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
262 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
263 | !BOP ------------------------------------------------------------------- |
---|
264 | ! |
---|
265 | ! !IROUTINE: typeI_ - return MPI datatype of INTEGER |
---|
266 | ! |
---|
267 | ! !DESCRIPTION: |
---|
268 | ! |
---|
269 | ! !INTERFACE: |
---|
270 | |
---|
271 | function typeI_(ival) |
---|
272 | implicit none |
---|
273 | integer,intent(in) :: ival |
---|
274 | integer :: typeI_ |
---|
275 | |
---|
276 | ! !REVISION HISTORY: |
---|
277 | ! 28Sep99 - Jing Guo <guo@dao.gsfc.nasa.gov> |
---|
278 | ! - initial prototype/prolog/code |
---|
279 | !EOP ___________________________________________________________________ |
---|
280 | |
---|
281 | character(len=*),parameter :: myname_=myname//'::typeI_' |
---|
282 | |
---|
283 | typeI_=MP_INTEGER |
---|
284 | |
---|
285 | end function typeI_ |
---|
286 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
287 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
288 | !BOP ------------------------------------------------------------------- |
---|
289 | ! |
---|
290 | ! !IROUTINE: typeL_ - return MPI datatype of LOGICAL |
---|
291 | ! |
---|
292 | ! !DESCRIPTION: |
---|
293 | ! |
---|
294 | ! !INTERFACE: |
---|
295 | |
---|
296 | function typeL_(lval) |
---|
297 | implicit none |
---|
298 | logical,intent(in) :: lval |
---|
299 | integer :: typeL_ |
---|
300 | |
---|
301 | ! !REVISION HISTORY: |
---|
302 | ! 28Sep99 - Jing Guo <guo@dao.gsfc.nasa.gov> |
---|
303 | ! - initial prototype/prolog/code |
---|
304 | !EOP ___________________________________________________________________ |
---|
305 | |
---|
306 | character(len=*),parameter :: myname_=myname//'::typeL_' |
---|
307 | |
---|
308 | typeL_=MP_LOGICAL |
---|
309 | |
---|
310 | end function typeL_ |
---|
311 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
312 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
313 | !BOP ------------------------------------------------------------------- |
---|
314 | ! |
---|
315 | ! !IROUTINE: typeC_ - return MPI datatype of CHARACTER |
---|
316 | ! |
---|
317 | ! !DESCRIPTION: |
---|
318 | ! |
---|
319 | ! !INTERFACE: |
---|
320 | |
---|
321 | function typeC_(cval) |
---|
322 | implicit none |
---|
323 | character(len=*),intent(in) :: cval |
---|
324 | integer :: typeC_ |
---|
325 | |
---|
326 | ! !REVISION HISTORY: |
---|
327 | ! 28Sep99 - Jing Guo <guo@dao.gsfc.nasa.gov> |
---|
328 | ! - initial prototype/prolog/code |
---|
329 | !EOP ___________________________________________________________________ |
---|
330 | |
---|
331 | character(len=*),parameter :: myname_=myname//'::typeC_' |
---|
332 | |
---|
333 | typeC_=MP_CHARACTER |
---|
334 | |
---|
335 | end function typeC_ |
---|
336 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
337 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
338 | !BOP ------------------------------------------------------------------- |
---|
339 | ! |
---|
340 | ! !IROUTINE: typeSP_ - return MPI datatype of single precision REAL |
---|
341 | ! |
---|
342 | ! !DESCRIPTION: |
---|
343 | ! |
---|
344 | ! !INTERFACE: |
---|
345 | |
---|
346 | function typeSP_(rval) |
---|
347 | use m_realkinds,only : SP |
---|
348 | implicit none |
---|
349 | real(SP),intent(in) :: rval |
---|
350 | integer :: typeSP_ |
---|
351 | |
---|
352 | ! !REVISION HISTORY: |
---|
353 | ! 28Sep99 - Jing Guo <guo@dao.gsfc.nasa.gov> |
---|
354 | ! - initial prototype/prolog/code |
---|
355 | !EOP ___________________________________________________________________ |
---|
356 | |
---|
357 | character(len=*),parameter :: myname_=myname//'::typeSP_' |
---|
358 | |
---|
359 | typeSP_=MP_REAL |
---|
360 | |
---|
361 | end function typeSP_ |
---|
362 | |
---|
363 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
364 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
365 | !BOP ------------------------------------------------------------------- |
---|
366 | ! |
---|
367 | ! !IROUTINE: typeDP_ - return MPI datatype of double precision REAL |
---|
368 | ! |
---|
369 | ! !DESCRIPTION: |
---|
370 | ! |
---|
371 | ! !INTERFACE: |
---|
372 | |
---|
373 | function typeDP_(rval) |
---|
374 | use m_realkinds,only : DP |
---|
375 | implicit none |
---|
376 | real(DP),intent(in) :: rval |
---|
377 | integer :: typeDP_ |
---|
378 | |
---|
379 | ! !REVISION HISTORY: |
---|
380 | ! 28Sep99 - Jing Guo <guo@dao.gsfc.nasa.gov> |
---|
381 | ! - initial prototype/prolog/code |
---|
382 | !EOP ___________________________________________________________________ |
---|
383 | |
---|
384 | character(len=*),parameter :: myname_=myname//'::typeDP_' |
---|
385 | |
---|
386 | typeDP_=MP_DOUBLE_PRECISION |
---|
387 | |
---|
388 | end function typeDP_ |
---|
389 | |
---|
390 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
391 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
392 | !BOP ------------------------------------------------------------------- |
---|
393 | ! |
---|
394 | ! !IROUTINE: typeI1_ - return MPI datatype of INTEGER |
---|
395 | ! |
---|
396 | ! !DESCRIPTION: |
---|
397 | ! |
---|
398 | ! !INTERFACE: |
---|
399 | |
---|
400 | function typeI1_(ival) |
---|
401 | implicit none |
---|
402 | integer,dimension(:),intent(in) :: ival |
---|
403 | integer :: typeI1_ |
---|
404 | |
---|
405 | ! !REVISION HISTORY: |
---|
406 | ! 28Sep99 - Jing Guo <guo@dao.gsfc.nasa.gov> |
---|
407 | ! - initial prototype/prolog/code |
---|
408 | !EOP ___________________________________________________________________ |
---|
409 | |
---|
410 | character(len=*),parameter :: myname_=myname//'::typeI1_' |
---|
411 | |
---|
412 | typeI1_=MP_INTEGER |
---|
413 | |
---|
414 | end function typeI1_ |
---|
415 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
416 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
417 | !BOP ------------------------------------------------------------------- |
---|
418 | ! |
---|
419 | ! !IROUTINE: typeL1_ - return MPI datatype of LOGICAL |
---|
420 | ! |
---|
421 | ! !DESCRIPTION: |
---|
422 | ! |
---|
423 | ! !INTERFACE: |
---|
424 | |
---|
425 | function typeL1_(lval) |
---|
426 | implicit none |
---|
427 | logical,dimension(:),intent(in) :: lval |
---|
428 | integer :: typeL1_ |
---|
429 | |
---|
430 | ! !REVISION HISTORY: |
---|
431 | ! 28Sep99 - Jing Guo <guo@dao.gsfc.nasa.gov> |
---|
432 | ! - initial prototype/prolog/code |
---|
433 | !EOP ___________________________________________________________________ |
---|
434 | |
---|
435 | character(len=*),parameter :: myname_=myname//'::typeL1_' |
---|
436 | |
---|
437 | typeL1_=MP_LOGICAL |
---|
438 | |
---|
439 | end function typeL1_ |
---|
440 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
441 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
442 | !BOP ------------------------------------------------------------------- |
---|
443 | ! |
---|
444 | ! !IROUTINE: typeC1_ - return MPI datatype of CHARACTER |
---|
445 | ! |
---|
446 | ! !DESCRIPTION: |
---|
447 | ! |
---|
448 | ! !INTERFACE: |
---|
449 | |
---|
450 | function typeC1_(cval) |
---|
451 | implicit none |
---|
452 | character(len=*),dimension(:),intent(in) :: cval |
---|
453 | integer :: typeC1_ |
---|
454 | |
---|
455 | ! !REVISION HISTORY: |
---|
456 | ! 28Sep99 - Jing Guo <guo@dao.gsfc.nasa.gov> |
---|
457 | ! - initial prototype/prolog/code |
---|
458 | !EOP ___________________________________________________________________ |
---|
459 | |
---|
460 | character(len=*),parameter :: myname_=myname//'::typeC1_' |
---|
461 | |
---|
462 | typeC1_=MP_CHARACTER |
---|
463 | |
---|
464 | end function typeC1_ |
---|
465 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
466 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
467 | !BOP ------------------------------------------------------------------- |
---|
468 | ! |
---|
469 | ! !IROUTINE: typeSP1_ - return MPI datatype of single precision REAL |
---|
470 | ! |
---|
471 | ! !DESCRIPTION: |
---|
472 | ! |
---|
473 | ! !INTERFACE: |
---|
474 | |
---|
475 | function typeSP1_(rval) |
---|
476 | use m_realkinds,only : SP |
---|
477 | implicit none |
---|
478 | real(SP),dimension(:),intent(in) :: rval |
---|
479 | integer :: typeSP1_ |
---|
480 | |
---|
481 | ! !REVISION HISTORY: |
---|
482 | ! 28Sep99 - Jing Guo <guo@dao.gsfc.nasa.gov> |
---|
483 | ! - initial prototype/prolog/code |
---|
484 | !EOP ___________________________________________________________________ |
---|
485 | |
---|
486 | character(len=*),parameter :: myname_=myname//'::typeSP1_' |
---|
487 | |
---|
488 | typeSP1_=MP_REAL |
---|
489 | |
---|
490 | end function typeSP1_ |
---|
491 | |
---|
492 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
493 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
494 | !BOP ------------------------------------------------------------------- |
---|
495 | ! |
---|
496 | ! !IROUTINE: typeDP1_ - return MPI datatype of double precision REAL |
---|
497 | ! |
---|
498 | ! !DESCRIPTION: |
---|
499 | ! |
---|
500 | ! !INTERFACE: |
---|
501 | |
---|
502 | function typeDP1_(rval) |
---|
503 | use m_realkinds,only : DP |
---|
504 | implicit none |
---|
505 | real(DP),dimension(:),intent(in) :: rval |
---|
506 | integer :: typeDP1_ |
---|
507 | |
---|
508 | ! !REVISION HISTORY: |
---|
509 | ! 28Sep99 - Jing Guo <guo@dao.gsfc.nasa.gov> |
---|
510 | ! - initial prototype/prolog/code |
---|
511 | !EOP ___________________________________________________________________ |
---|
512 | |
---|
513 | character(len=*),parameter :: myname_=myname//'::typeDP1_' |
---|
514 | |
---|
515 | typeDP1_=MP_DOUBLE_PRECISION |
---|
516 | |
---|
517 | end function typeDP1_ |
---|
518 | |
---|
519 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
520 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
521 | !BOP ------------------------------------------------------------------- |
---|
522 | ! |
---|
523 | ! !IROUTINE: typeI2_ - return MPI datatype of INTEGER |
---|
524 | ! |
---|
525 | ! !DESCRIPTION: |
---|
526 | ! |
---|
527 | ! !INTERFACE: |
---|
528 | |
---|
529 | function typeI2_(ival) |
---|
530 | implicit none |
---|
531 | integer,dimension(:,:),intent(in) :: ival |
---|
532 | integer :: typeI2_ |
---|
533 | |
---|
534 | ! !REVISION HISTORY: |
---|
535 | ! 28Sep99 - Jing Guo <guo@dao.gsfc.nasa.gov> |
---|
536 | ! - initial prototype/prolog/code |
---|
537 | !EOP ___________________________________________________________________ |
---|
538 | |
---|
539 | character(len=*),parameter :: myname_=myname//'::typeI2_' |
---|
540 | |
---|
541 | typeI2_=MP_INTEGER |
---|
542 | |
---|
543 | end function typeI2_ |
---|
544 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
545 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
546 | !BOP ------------------------------------------------------------------- |
---|
547 | ! |
---|
548 | ! !IROUTINE: typeL2_ - return MPI datatype of LOGICAL |
---|
549 | ! |
---|
550 | ! !DESCRIPTION: |
---|
551 | ! |
---|
552 | ! !INTERFACE: |
---|
553 | |
---|
554 | function typeL2_(lval) |
---|
555 | implicit none |
---|
556 | logical,dimension(:,:),intent(in) :: lval |
---|
557 | integer :: typeL2_ |
---|
558 | |
---|
559 | ! !REVISION HISTORY: |
---|
560 | ! 28Sep99 - Jing Guo <guo@dao.gsfc.nasa.gov> |
---|
561 | ! - initial prototype/prolog/code |
---|
562 | !EOP ___________________________________________________________________ |
---|
563 | |
---|
564 | character(len=*),parameter :: myname_=myname//'::typeL2_' |
---|
565 | |
---|
566 | typeL2_=MP_LOGICAL |
---|
567 | |
---|
568 | end function typeL2_ |
---|
569 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
570 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
571 | !BOP ------------------------------------------------------------------- |
---|
572 | ! |
---|
573 | ! !IROUTINE: typeC2_ - return MPI datatype of CHARACTER |
---|
574 | ! |
---|
575 | ! !DESCRIPTION: |
---|
576 | ! |
---|
577 | ! !INTERFACE: |
---|
578 | |
---|
579 | function typeC2_(cval) |
---|
580 | implicit none |
---|
581 | character(len=*),dimension(:,:),intent(in) :: cval |
---|
582 | integer :: typeC2_ |
---|
583 | |
---|
584 | ! !REVISION HISTORY: |
---|
585 | ! 28Sep99 - Jing Guo <guo@dao.gsfc.nasa.gov> |
---|
586 | ! - initial prototype/prolog/code |
---|
587 | !EOP ___________________________________________________________________ |
---|
588 | |
---|
589 | character(len=*),parameter :: myname_=myname//'::typeC2_' |
---|
590 | |
---|
591 | typeC2_=MP_CHARACTER |
---|
592 | |
---|
593 | end function typeC2_ |
---|
594 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
595 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
596 | !BOP ------------------------------------------------------------------- |
---|
597 | ! |
---|
598 | ! !IROUTINE: typeSP2_ - return MPI datatype of single precision REAL |
---|
599 | ! |
---|
600 | ! !DESCRIPTION: |
---|
601 | ! |
---|
602 | ! !INTERFACE: |
---|
603 | |
---|
604 | function typeSP2_(rval) |
---|
605 | use m_realkinds,only : SP |
---|
606 | implicit none |
---|
607 | real(SP),dimension(:,:),intent(in) :: rval |
---|
608 | integer :: typeSP2_ |
---|
609 | |
---|
610 | ! !REVISION HISTORY: |
---|
611 | ! 28Sep99 - Jing Guo <guo@dao.gsfc.nasa.gov> |
---|
612 | ! - initial prototype/prolog/code |
---|
613 | !EOP ___________________________________________________________________ |
---|
614 | |
---|
615 | character(len=*),parameter :: myname_=myname//'::typeSP2_' |
---|
616 | |
---|
617 | typeSP2_=MP_REAL |
---|
618 | |
---|
619 | end function typeSP2_ |
---|
620 | |
---|
621 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
622 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
623 | !BOP ------------------------------------------------------------------- |
---|
624 | ! |
---|
625 | ! !IROUTINE: typeDP2_ - return MPI datatype of double precision REAL |
---|
626 | ! |
---|
627 | ! !DESCRIPTION: |
---|
628 | ! |
---|
629 | ! !INTERFACE: |
---|
630 | |
---|
631 | function typeDP2_(rval) |
---|
632 | use m_realkinds,only : DP |
---|
633 | implicit none |
---|
634 | real(DP),dimension(:,:),intent(in) :: rval |
---|
635 | integer :: typeDP2_ |
---|
636 | |
---|
637 | ! !REVISION HISTORY: |
---|
638 | ! 28Sep99 - Jing Guo <guo@dao.gsfc.nasa.gov> |
---|
639 | ! - initial prototype/prolog/code |
---|
640 | !EOP ___________________________________________________________________ |
---|
641 | |
---|
642 | character(len=*),parameter :: myname_=myname//'::typeDP2_' |
---|
643 | |
---|
644 | typeDP2_=MP_DOUBLE_PRECISION |
---|
645 | |
---|
646 | end function typeDP2_ |
---|
647 | |
---|
648 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
649 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
650 | !BOP ------------------------------------------------------------------- |
---|
651 | ! |
---|
652 | ! !IROUTINE: perr_ - MPI error information hanlder |
---|
653 | ! |
---|
654 | ! !DESCRIPTION: |
---|
655 | ! |
---|
656 | ! !INTERFACE: |
---|
657 | |
---|
658 | subroutine perr_(proc,MP_proc,ierror) |
---|
659 | use m_stdio, only : stderr |
---|
660 | implicit none |
---|
661 | character(len=*),intent(in) :: proc |
---|
662 | character(len=*),intent(in) :: MP_proc |
---|
663 | integer,intent(in) :: ierror |
---|
664 | |
---|
665 | ! !REVISION HISTORY: |
---|
666 | ! 21Apr98 - Jing Guo <guo@thunder> - initial prototype/prolog/code |
---|
667 | !EOP ___________________________________________________________________ |
---|
668 | |
---|
669 | character(len=*),parameter :: myname_=myname//'::perr_' |
---|
670 | |
---|
671 | character(len=MP_MAX_ERROR_STRING) :: estr |
---|
672 | integer :: ln,ier |
---|
673 | |
---|
674 | call MP_error_string(ierror,estr,ln,ier) |
---|
675 | if(ier /= 0 .or. ln<=0) then |
---|
676 | write(stderr,'(4a,i4)') proc,': ', & |
---|
677 | MP_proc,' error, ierror =',ierror |
---|
678 | else |
---|
679 | write(stderr,'(6a)') proc,': ', & |
---|
680 | MP_proc,' error, "',estr(1:ln),'"' |
---|
681 | endif |
---|
682 | |
---|
683 | end subroutine perr_ |
---|
684 | |
---|
685 | !~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ |
---|
686 | ! NASA/GSFC, Data Assimilation Office, Code 910.3, GEOS/DAS ! |
---|
687 | !BOP ------------------------------------------------------------------- |
---|
688 | ! |
---|
689 | ! !IROUTINE: MP_log2 - The smallest integer its power of 2 is >= nPE |
---|
690 | ! |
---|
691 | ! !DESCRIPTION: |
---|
692 | ! |
---|
693 | ! !INTERFACE: |
---|
694 | |
---|
695 | function MP_log2(nPE) |
---|
696 | implicit none |
---|
697 | integer,intent(in) :: nPE |
---|
698 | integer :: MP_log2 |
---|
699 | |
---|
700 | ! !REVISION HISTORY: |
---|
701 | ! 01Feb00 - Jing Guo <guo@dao.gsfc.nasa.gov> |
---|
702 | ! - initial prototype/prolog/code |
---|
703 | !EOP ___________________________________________________________________ |
---|
704 | |
---|
705 | character(len=*),parameter :: myname_=myname//'::MP_log2' |
---|
706 | |
---|
707 | integer :: n2 |
---|
708 | |
---|
709 | MP_log2=0 |
---|
710 | n2=1 |
---|
711 | do while(n2<nPE) |
---|
712 | MP_log2 = MP_log2+1 |
---|
713 | n2 = n2+n2 |
---|
714 | end do |
---|
715 | |
---|
716 | end function MP_log2 |
---|
717 | |
---|
718 | end module m_mpif90 |
---|
719 | !. |
---|