- Timestamp:
- 2020-07-03T19:15:31+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/lib_mpp.F90
r13229 r13247 67 67 PUBLIC mpp_ini_znl 68 68 PUBLIC mppsend, mpprecv ! needed by TAM and ICB routines 69 PUBLIC mppsend_sp, mpprecv_sp ! needed by TAM and ICB routines 70 PUBLIC mppsend_dp, mpprecv_dp ! needed by TAM and ICB routines 69 71 PUBLIC mpp_report 70 72 PUBLIC mpp_bcast_nml … … 79 81 !! for the compilation on AIX system as well as NEC and SGI. Ok on COMPACQ 80 82 INTERFACE mpp_min 81 MODULE PROCEDURE mppmin_a_int, mppmin_int, mppmin_a_real, mppmin_real 83 MODULE PROCEDURE mppmin_a_int, mppmin_int 84 MODULE PROCEDURE mppmin_a_real_sp, mppmin_real_sp 85 MODULE PROCEDURE mppmin_a_real_dp, mppmin_real_dp 82 86 END INTERFACE 83 87 INTERFACE mpp_max 84 MODULE PROCEDURE mppmax_a_int, mppmax_int, mppmax_a_real, mppmax_real 88 MODULE PROCEDURE mppmax_a_int, mppmax_int 89 MODULE PROCEDURE mppmax_a_real_sp, mppmax_real_sp 90 MODULE PROCEDURE mppmax_a_real_dp, mppmax_real_dp 85 91 END INTERFACE 86 92 INTERFACE mpp_sum 87 MODULE PROCEDURE mppsum_a_int, mppsum_int, mppsum_a_real, mppsum_real, & 88 & mppsum_realdd, mppsum_a_realdd 93 MODULE PROCEDURE mppsum_a_int, mppsum_int 94 MODULE PROCEDURE mppsum_realdd, mppsum_a_realdd 95 MODULE PROCEDURE mppsum_a_real_sp, mppsum_real_sp 96 MODULE PROCEDURE mppsum_a_real_dp, mppsum_real_dp 89 97 END INTERFACE 90 98 INTERFACE mpp_minloc 91 MODULE PROCEDURE mpp_minloc2d ,mpp_minloc3d 99 MODULE PROCEDURE mpp_minloc2d_sp ,mpp_minloc3d_sp 100 MODULE PROCEDURE mpp_minloc2d_dp ,mpp_minloc3d_dp 92 101 END INTERFACE 93 102 INTERFACE mpp_maxloc 94 MODULE PROCEDURE mpp_maxloc2d ,mpp_maxloc3d 103 MODULE PROCEDURE mpp_maxloc2d_sp ,mpp_maxloc3d_sp 104 MODULE PROCEDURE mpp_maxloc2d_dp ,mpp_maxloc3d_dp 95 105 END INTERFACE 96 106 … … 158 168 TYPE, PUBLIC :: DELAYARR 159 169 REAL( wp), POINTER, DIMENSION(:) :: z1d => NULL() 160 COMPLEX( wp), POINTER, DIMENSION(:) :: y1d => NULL()170 COMPLEX(dp), POINTER, DIMENSION(:) :: y1d => NULL() 161 171 END TYPE DELAYARR 162 172 TYPE( DELAYARR ), DIMENSION(nbdelay), PUBLIC, SAVE :: todelay !: must have SAVE for default initialization of DELAYARR … … 164 174 165 175 ! timing summary report 166 REAL( wp), DIMENSION(2), PUBLIC :: waiting_time = 0._wp167 REAL( wp) , PUBLIC :: compute_time = 0._wp, elapsed_time = 0._wp176 REAL(dp), DIMENSION(2), PUBLIC :: waiting_time = 0._dp 177 REAL(dp) , PUBLIC :: compute_time = 0._dp, elapsed_time = 0._dp 168 178 169 179 REAL(wp), DIMENSION(:), ALLOCATABLE, SAVE :: tampon ! buffer in case of bsend … … 251 261 !! 252 262 INTEGER :: iflag 263 INTEGER :: mpi_working_type 264 !!---------------------------------------------------------------------- 265 ! 266 #if defined key_mpp_mpi 267 IF (wp == dp) THEN 268 mpi_working_type = mpi_double_precision 269 ELSE 270 mpi_working_type = mpi_real 271 END IF 272 CALL mpi_isend( pmess, kbytes, mpi_working_type, kdest , ktyp, mpi_comm_oce, md_req, iflag ) 273 #endif 274 ! 275 END SUBROUTINE mppsend 276 277 278 SUBROUTINE mppsend_dp( ktyp, pmess, kbytes, kdest, md_req ) 279 !!---------------------------------------------------------------------- 280 !! *** routine mppsend *** 281 !! 282 !! ** Purpose : Send messag passing array 283 !! 284 !!---------------------------------------------------------------------- 285 REAL(dp), INTENT(inout) :: pmess(*) ! array of real 286 INTEGER , INTENT(in ) :: kbytes ! size of the array pmess 287 INTEGER , INTENT(in ) :: kdest ! receive process number 288 INTEGER , INTENT(in ) :: ktyp ! tag of the message 289 INTEGER , INTENT(in ) :: md_req ! argument for isend 290 !! 291 INTEGER :: iflag 253 292 !!---------------------------------------------------------------------- 254 293 ! … … 257 296 #endif 258 297 ! 259 END SUBROUTINE mppsend 298 END SUBROUTINE mppsend_dp 299 300 301 SUBROUTINE mppsend_sp( ktyp, pmess, kbytes, kdest, md_req ) 302 !!---------------------------------------------------------------------- 303 !! *** routine mppsend *** 304 !! 305 !! ** Purpose : Send messag passing array 306 !! 307 !!---------------------------------------------------------------------- 308 REAL(sp), INTENT(inout) :: pmess(*) ! array of real 309 INTEGER , INTENT(in ) :: kbytes ! size of the array pmess 310 INTEGER , INTENT(in ) :: kdest ! receive process number 311 INTEGER , INTENT(in ) :: ktyp ! tag of the message 312 INTEGER , INTENT(in ) :: md_req ! argument for isend 313 !! 314 INTEGER :: iflag 315 !!---------------------------------------------------------------------- 316 ! 317 #if defined key_mpp_mpi 318 CALL mpi_isend( pmess, kbytes, mpi_real, kdest , ktyp, mpi_comm_oce, md_req, iflag ) 319 #endif 320 ! 321 END SUBROUTINE mppsend_sp 260 322 261 323 … … 275 337 INTEGER :: iflag 276 338 INTEGER :: use_source 339 INTEGER :: mpi_working_type 277 340 !!---------------------------------------------------------------------- 278 341 ! … … 283 346 IF( PRESENT(ksource) ) use_source = ksource 284 347 ! 348 IF (wp == dp) THEN 349 mpi_working_type = mpi_double_precision 350 ELSE 351 mpi_working_type = mpi_real 352 END IF 353 CALL mpi_recv( pmess, kbytes, mpi_working_type, use_source, ktyp, mpi_comm_oce, istatus, iflag ) 354 #endif 355 ! 356 END SUBROUTINE mpprecv 357 358 SUBROUTINE mpprecv_dp( ktyp, pmess, kbytes, ksource ) 359 !!---------------------------------------------------------------------- 360 !! *** routine mpprecv *** 361 !! 362 !! ** Purpose : Receive messag passing array 363 !! 364 !!---------------------------------------------------------------------- 365 REAL(dp), INTENT(inout) :: pmess(*) ! array of real 366 INTEGER , INTENT(in ) :: kbytes ! suze of the array pmess 367 INTEGER , INTENT(in ) :: ktyp ! Tag of the recevied message 368 INTEGER, OPTIONAL, INTENT(in) :: ksource ! source process number 369 !! 370 INTEGER :: istatus(mpi_status_size) 371 INTEGER :: iflag 372 INTEGER :: use_source 373 !!---------------------------------------------------------------------- 374 ! 375 #if defined key_mpp_mpi 376 ! If a specific process number has been passed to the receive call, 377 ! use that one. Default is to use mpi_any_source 378 use_source = mpi_any_source 379 IF( PRESENT(ksource) ) use_source = ksource 380 ! 285 381 CALL mpi_recv( pmess, kbytes, mpi_double_precision, use_source, ktyp, mpi_comm_oce, istatus, iflag ) 286 382 #endif 287 383 ! 288 END SUBROUTINE mpprecv 384 END SUBROUTINE mpprecv_dp 385 386 387 SUBROUTINE mpprecv_sp( ktyp, pmess, kbytes, ksource ) 388 !!---------------------------------------------------------------------- 389 !! *** routine mpprecv *** 390 !! 391 !! ** Purpose : Receive messag passing array 392 !! 393 !!---------------------------------------------------------------------- 394 REAL(sp), INTENT(inout) :: pmess(*) ! array of real 395 INTEGER , INTENT(in ) :: kbytes ! suze of the array pmess 396 INTEGER , INTENT(in ) :: ktyp ! Tag of the recevied message 397 INTEGER, OPTIONAL, INTENT(in) :: ksource ! source process number 398 !! 399 INTEGER :: istatus(mpi_status_size) 400 INTEGER :: iflag 401 INTEGER :: use_source 402 !!---------------------------------------------------------------------- 403 ! 404 #if defined key_mpp_mpi 405 ! If a specific process number has been passed to the receive call, 406 ! use that one. Default is to use mpi_any_source 407 use_source = mpi_any_source 408 IF( PRESENT(ksource) ) use_source = ksource 409 ! 410 CALL mpi_recv( pmess, kbytes, mpi_real, use_source, ktyp, mpi_comm_oce, istatus, iflag ) 411 #endif 412 ! 413 END SUBROUTINE mpprecv_sp 289 414 290 415 … … 351 476 CHARACTER(len=*), INTENT(in ) :: cdname ! name of the calling subroutine 352 477 CHARACTER(len=*), INTENT(in ) :: cdelay ! name (used as id) of the delayed operation 353 COMPLEX( wp), INTENT(in ), DIMENSION(:) :: y_in478 COMPLEX(dp), INTENT(in ), DIMENSION(:) :: y_in 354 479 REAL(wp), INTENT( out), DIMENSION(:) :: pout 355 480 LOGICAL, INTENT(in ) :: ldlast ! true if this is the last time we call this routine … … 359 484 INTEGER :: idvar 360 485 INTEGER :: ierr, ilocalcomm 361 COMPLEX( wp), ALLOCATABLE, DIMENSION(:) :: ytmp486 COMPLEX(dp), ALLOCATABLE, DIMENSION(:) :: ytmp 362 487 !!---------------------------------------------------------------------- 363 488 #if defined key_mpp_mpi … … 432 557 INTEGER :: idvar 433 558 INTEGER :: ierr, ilocalcomm 434 !!---------------------------------------------------------------------- 435 #if defined key_mpp_mpi 559 INTEGER :: MPI_TYPE 560 !!---------------------------------------------------------------------- 561 562 #if defined key_mpp_mpi 563 if( wp == dp ) then 564 MPI_TYPE = MPI_DOUBLE_PRECISION 565 else if ( wp == sp ) then 566 MPI_TYPE = MPI_REAL 567 else 568 CALL ctl_stop( "Error defining type, wp is neither dp nor sp" ) 569 570 end if 571 436 572 ilocalcomm = mpi_comm_oce 437 573 IF( PRESENT(kcom) ) ilocalcomm = kcom … … 470 606 # if defined key_mpi2 471 607 IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.) 472 CALL mpi_allreduce( p_in(:), todelay(idvar)%z1d(:), isz, MPI_DOUBLE_PRECISION, mpi_max, ilocalcomm, ierr ) 473 ndelayid(idvar) = 1 608 CALL mpi_allreduce( p_in(:), todelay(idvar)%z1d(:), isz, MPI_TYPE, mpi_max, ilocalcomm, ndelayid(idvar), ierr ) 474 609 IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.) 475 610 # else 476 CALL mpi_iallreduce( p_in(:), todelay(idvar)%z1d(:), isz, MPI_ DOUBLE_PRECISION, mpi_max, ilocalcomm, ndelayid(idvar), ierr )611 CALL mpi_iallreduce( p_in(:), todelay(idvar)%z1d(:), isz, MPI_TYPE, mpi_max, ilocalcomm, ndelayid(idvar), ierr ) 477 612 # endif 478 613 #else … … 551 686 # undef INTEGER_TYPE 552 687 ! 688 !! 689 !! ---- SINGLE PRECISION VERSIONS 690 !! 691 # define SINGLE_PRECISION 553 692 # define REAL_TYPE 554 693 # define DIM_0d 555 # define ROUTINE_ALLREDUCE mppmax_real 694 # define ROUTINE_ALLREDUCE mppmax_real_sp 556 695 # include "mpp_allreduce_generic.h90" 557 696 # undef ROUTINE_ALLREDUCE 558 697 # undef DIM_0d 559 698 # define DIM_1d 560 # define ROUTINE_ALLREDUCE mppmax_a_real 699 # define ROUTINE_ALLREDUCE mppmax_a_real_sp 700 # include "mpp_allreduce_generic.h90" 701 # undef ROUTINE_ALLREDUCE 702 # undef DIM_1d 703 # undef SINGLE_PRECISION 704 !! 705 !! 706 !! ---- DOUBLE PRECISION VERSIONS 707 !! 708 ! 709 # define DIM_0d 710 # define ROUTINE_ALLREDUCE mppmax_real_dp 711 # include "mpp_allreduce_generic.h90" 712 # undef ROUTINE_ALLREDUCE 713 # undef DIM_0d 714 # define DIM_1d 715 # define ROUTINE_ALLREDUCE mppmax_a_real_dp 561 716 # include "mpp_allreduce_generic.h90" 562 717 # undef ROUTINE_ALLREDUCE … … 583 738 # undef INTEGER_TYPE 584 739 ! 740 !! 741 !! ---- SINGLE PRECISION VERSIONS 742 !! 743 # define SINGLE_PRECISION 585 744 # define REAL_TYPE 586 745 # define DIM_0d 587 # define ROUTINE_ALLREDUCE mppmin_real 746 # define ROUTINE_ALLREDUCE mppmin_real_sp 588 747 # include "mpp_allreduce_generic.h90" 589 748 # undef ROUTINE_ALLREDUCE 590 749 # undef DIM_0d 591 750 # define DIM_1d 592 # define ROUTINE_ALLREDUCE mppmin_a_real 751 # define ROUTINE_ALLREDUCE mppmin_a_real_sp 752 # include "mpp_allreduce_generic.h90" 753 # undef ROUTINE_ALLREDUCE 754 # undef DIM_1d 755 # undef SINGLE_PRECISION 756 !! 757 !! ---- DOUBLE PRECISION VERSIONS 758 !! 759 760 # define DIM_0d 761 # define ROUTINE_ALLREDUCE mppmin_real_dp 762 # include "mpp_allreduce_generic.h90" 763 # undef ROUTINE_ALLREDUCE 764 # undef DIM_0d 765 # define DIM_1d 766 # define ROUTINE_ALLREDUCE mppmin_a_real_dp 593 767 # include "mpp_allreduce_generic.h90" 594 768 # undef ROUTINE_ALLREDUCE … … 616 790 # undef DIM_1d 617 791 # undef INTEGER_TYPE 618 ! 792 793 !! 794 !! ---- SINGLE PRECISION VERSIONS 795 !! 796 # define OPERATION_SUM 797 # define SINGLE_PRECISION 619 798 # define REAL_TYPE 620 799 # define DIM_0d 621 # define ROUTINE_ALLREDUCE mppsum_real 800 # define ROUTINE_ALLREDUCE mppsum_real_sp 622 801 # include "mpp_allreduce_generic.h90" 623 802 # undef ROUTINE_ALLREDUCE 624 803 # undef DIM_0d 625 804 # define DIM_1d 626 # define ROUTINE_ALLREDUCE mppsum_a_real 805 # define ROUTINE_ALLREDUCE mppsum_a_real_sp 806 # include "mpp_allreduce_generic.h90" 807 # undef ROUTINE_ALLREDUCE 808 # undef DIM_1d 809 # undef REAL_TYPE 810 # undef OPERATION_SUM 811 812 # undef SINGLE_PRECISION 813 814 !! 815 !! ---- DOUBLE PRECISION VERSIONS 816 !! 817 # define OPERATION_SUM 818 # define REAL_TYPE 819 # define DIM_0d 820 # define ROUTINE_ALLREDUCE mppsum_real_dp 821 # include "mpp_allreduce_generic.h90" 822 # undef ROUTINE_ALLREDUCE 823 # undef DIM_0d 824 # define DIM_1d 825 # define ROUTINE_ALLREDUCE mppsum_a_real_dp 627 826 # include "mpp_allreduce_generic.h90" 628 827 # undef ROUTINE_ALLREDUCE … … 651 850 !!---------------------------------------------------------------------- 652 851 !! 852 !! 853 !! ---- SINGLE PRECISION VERSIONS 854 !! 855 # define SINGLE_PRECISION 653 856 # define OPERATION_MINLOC 654 857 # define DIM_2d 655 # define ROUTINE_LOC mpp_minloc2d 858 # define ROUTINE_LOC mpp_minloc2d_sp 656 859 # include "mpp_loc_generic.h90" 657 860 # undef ROUTINE_LOC 658 861 # undef DIM_2d 659 862 # define DIM_3d 660 # define ROUTINE_LOC mpp_minloc3d 863 # define ROUTINE_LOC mpp_minloc3d_sp 661 864 # include "mpp_loc_generic.h90" 662 865 # undef ROUTINE_LOC … … 666 869 # define OPERATION_MAXLOC 667 870 # define DIM_2d 668 # define ROUTINE_LOC mpp_maxloc2d 871 # define ROUTINE_LOC mpp_maxloc2d_sp 669 872 # include "mpp_loc_generic.h90" 670 873 # undef ROUTINE_LOC 671 874 # undef DIM_2d 672 875 # define DIM_3d 673 # define ROUTINE_LOC mpp_maxloc3d 876 # define ROUTINE_LOC mpp_maxloc3d_sp 674 877 # include "mpp_loc_generic.h90" 675 878 # undef ROUTINE_LOC 676 879 # undef DIM_3d 677 880 # undef OPERATION_MAXLOC 881 # undef SINGLE_PRECISION 882 !! 883 !! ---- DOUBLE PRECISION VERSIONS 884 !! 885 # define OPERATION_MINLOC 886 # define DIM_2d 887 # define ROUTINE_LOC mpp_minloc2d_dp 888 # include "mpp_loc_generic.h90" 889 # undef ROUTINE_LOC 890 # undef DIM_2d 891 # define DIM_3d 892 # define ROUTINE_LOC mpp_minloc3d_dp 893 # include "mpp_loc_generic.h90" 894 # undef ROUTINE_LOC 895 # undef DIM_3d 896 # undef OPERATION_MINLOC 897 898 # define OPERATION_MAXLOC 899 # define DIM_2d 900 # define ROUTINE_LOC mpp_maxloc2d_dp 901 # include "mpp_loc_generic.h90" 902 # undef ROUTINE_LOC 903 # undef DIM_2d 904 # define DIM_3d 905 # define ROUTINE_LOC mpp_maxloc3d_dp 906 # include "mpp_loc_generic.h90" 907 # undef ROUTINE_LOC 908 # undef DIM_3d 909 # undef OPERATION_MAXLOC 910 678 911 679 912 SUBROUTINE mppsync() … … 904 1137 !!--------------------------------------------------------------------- 905 1138 INTEGER , INTENT(in) :: ilen, itype 906 COMPLEX( wp), DIMENSION(ilen), INTENT(in) :: ydda907 COMPLEX( wp), DIMENSION(ilen), INTENT(inout) :: yddb908 ! 909 REAL( wp) :: zerr, zt1, zt2 ! local work variables1139 COMPLEX(dp), DIMENSION(ilen), INTENT(in) :: ydda 1140 COMPLEX(dp), DIMENSION(ilen), INTENT(inout) :: yddb 1141 ! 1142 REAL(dp) :: zerr, zt1, zt2 ! local work variables 910 1143 INTEGER :: ji, ztmp ! local scalar 911 1144 !!--------------------------------------------------------------------- … … 1060 1293 LOGICAL, INTENT(IN) :: ld_tic 1061 1294 LOGICAL, OPTIONAL, INTENT(IN) :: ld_global 1062 REAL( wp), DIMENSION(2), SAVE :: tic_wt1063 REAL( wp), SAVE :: tic_ct = 0._wp1295 REAL(dp), DIMENSION(2), SAVE :: tic_wt 1296 REAL(dp), SAVE :: tic_ct = 0._dp 1064 1297 INTEGER :: ii 1065 1298 #if defined key_mpp_mpi … … 1074 1307 IF ( ld_tic ) THEN 1075 1308 tic_wt(ii) = MPI_Wtime() ! start count tic->tac (waiting time) 1076 IF ( tic_ct > 0.0_ wp ) compute_time = compute_time + MPI_Wtime() - tic_ct ! cumulate count tac->tic1309 IF ( tic_ct > 0.0_dp ) compute_time = compute_time + MPI_Wtime() - tic_ct ! cumulate count tac->tic 1077 1310 ELSE 1078 1311 waiting_time(ii) = waiting_time(ii) + MPI_Wtime() - tic_wt(ii) ! cumulate count tic->tac
Note: See TracChangeset
for help on using the changeset viewer.