Changeset 300 for trunk/NEMO/OPA_SRC/lib_mpp.F90
- Timestamp:
- 2005-09-22T13:07:01+02:00 (19 years ago)
- File:
-
- 1 edited
-
trunk/NEMO/OPA_SRC/lib_mpp.F90 (modified) (26 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMO/OPA_SRC/lib_mpp.F90
r247 r300 81 81 !! * Share module variables 82 82 LOGICAL, PUBLIC, PARAMETER :: lk_mpp = .TRUE. !: mpp flag 83 LOGICAL, PUBLIC :: lk_bsend = .FALSE. !: mpp_bsend flag84 LOGICAL, PUBLIC :: lk_isend = .FALSE. !: mpp_isend flag85 83 86 84 … … 112 110 INTEGER, DIMENSION(:), ALLOCATABLE :: & 113 111 nrank_north ! dimension ndim_rank_north, number of the procs belonging to ncomm_north 112 CHARACTER (len=1) :: & 113 c_mpi_send = 'S' ! type od mpi send/recieve (S=standard, B=bsend, I=isend) 114 LOGICAL :: & 115 l_isend = .FALSE. ! isend use indicator (T if c_mpi_send='I') 114 116 115 117 … … 260 262 !! * Local variables (MPI version) 261 263 INTEGER :: mynode, ierr 262 !!---------------------------------------------------------------------- 263 ! Enroll in MPI 264 ! ------------- 265 # if defined key_mpi_bsend 266 lk_bsend = .TRUE. !: mpp_bsend flag 267 # endif 268 # if defined key_mpi_isend 269 lk_isend = .TRUE. !: mpp_isend flag 270 # endif 271 272 IF(lk_bsend) THEN 264 NAMELIST/nam_mpp/ c_mpi_send 265 !!---------------------------------------------------------------------- 266 267 WRITE(numout,*) 268 WRITE(numout,*) 'mynode : mpi initialisation' 269 WRITE(numout,*) '~~~~~~ ' 270 WRITE(numout,*) 271 272 ! Namelist namrun : parameters of the run 273 REWIND( numnam ) 274 READ ( numnam, nam_mpp ) 275 276 WRITE(numout,*) ' Namelist nam_mpp' 277 WRITE(numout,*) ' mpi send type c_mpi_send = ', c_mpi_send 278 279 SELECT CASE ( c_mpi_send ) 280 CASE ( 'S' ) ! Standard mpi send (blocking) 281 WRITE(numout,*) ' Standard blocking mpi send (send)' 282 CALL mpi_init( ierr ) 283 CASE ( 'B' ) ! Buffer mpi send (blocking) 284 WRITE(numout,*) ' Buffer blocking mpi send (bsend)' 273 285 CALL mpi_init_opa( ierr ) 274 ELSE 286 CASE ( 'I' ) ! Immediate mpi send (non-blocking send) 287 WRITE(numout,*) ' Immediate non-blocking send (isend)' 288 l_isend = .TRUE. 275 289 CALL mpi_init( ierr ) 276 ENDIF 290 CASE DEFAULT 291 WRITE(numout,cform_err) 292 WRITE(numout,*) ' bad value for c_mpi_send = ', c_mpi_send 293 nstop = nstop + 1 294 END SELECT 295 277 296 CALL mpi_comm_rank( mpi_comm_world, rank, ierr ) 278 297 CALL mpi_comm_size( mpi_comm_world, size, ierr ) … … 606 625 CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req1 ) 607 626 CALL mpprecv( 1, t3ew(1,1,1,2), imigr ) 608 IF(l k_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)627 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 609 628 CASE ( 0 ) 610 629 CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 ) … … 612 631 CALL mpprecv( 1, t3ew(1,1,1,2), imigr ) 613 632 CALL mpprecv( 2, t3we(1,1,1,2), imigr ) 614 IF(l k_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)615 IF(l k_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)633 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 634 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 616 635 CASE ( 1 ) 617 636 CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 ) 618 637 CALL mpprecv( 2, t3we(1,1,1,2), imigr ) 619 IF(l k_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)638 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 620 639 END SELECT 621 640 #endif … … 684 703 CALL mppsend( 4, t3sn(1,1,1,1), imigr, nono, ml_req1 ) 685 704 CALL mpprecv( 3, t3ns(1,1,1,2), imigr ) 686 IF(l k_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)705 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 687 706 CASE ( 0 ) 688 707 CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 ) … … 690 709 CALL mpprecv( 3, t3ns(1,1,1,2), imigr ) 691 710 CALL mpprecv( 4, t3sn(1,1,1,2), imigr ) 692 IF(l k_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)693 IF(l k_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err)711 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 712 IF(l_isend) CALL mpi_wait(ml_req2, ml_stat, ml_err) 694 713 CASE ( 1 ) 695 714 CALL mppsend( 3, t3ns(1,1,1,1), imigr, noso, ml_req1 ) 696 715 CALL mpprecv( 4, t3sn(1,1,1,2), imigr ) 697 IF(l k_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err)716 IF(l_isend) CALL mpi_wait(ml_req1, ml_stat, ml_err) 698 717 END SELECT 699 718 … … 885 904 CALL mppsend( 2, t3we(1,1,1,1), imigr, noea, ml_req1 ) 886 905 CALL mpprecv( 1, t3ew(1,1,1,2), imigr ) 887 IF(l k_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)906 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 888 907 CASE ( 0 ) 889 908 CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 ) … … 891 910 CALL mpprecv( 1, t3ew(1,1,1,2), imigr ) 892 911 CALL mpprecv( 2, t3we(1,1,1,2), imigr ) 893 IF(l k_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)894 IF(l k_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)912 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 913 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 895 914 CASE ( 1 ) 896 915 CALL mppsend( 1, t3ew(1,1,1,1), imigr, nowe, ml_req1 ) 897 916 CALL mpprecv( 2, t3we(1,1,1,2), imigr ) 898 IF(l k_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)917 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 899 918 END SELECT 900 919 #endif … … 1041 1060 CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 ) 1042 1061 CALL mpprecv( 1, t2ew(1,1,2), imigr ) 1043 IF(l k_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)1062 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1044 1063 CASE ( 0 ) 1045 1064 CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 ) … … 1047 1066 CALL mpprecv( 1, t2ew(1,1,2), imigr ) 1048 1067 CALL mpprecv( 2, t2we(1,1,2), imigr ) 1049 IF(l k_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)1050 IF(l k_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)1068 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1069 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 1051 1070 CASE ( 1 ) 1052 1071 CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 ) 1053 1072 CALL mpprecv( 2, t2we(1,1,2), imigr ) 1054 IF(l k_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)1073 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1055 1074 END SELECT 1056 1075 … … 1118 1137 CALL mppsend( 4, t2sn(1,1,1), imigr, nono, ml_req1 ) 1119 1138 CALL mpprecv( 3, t2ns(1,1,2), imigr ) 1120 IF(l k_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)1139 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1121 1140 CASE ( 0 ) 1122 1141 CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 ) … … 1124 1143 CALL mpprecv( 3, t2ns(1,1,2), imigr ) 1125 1144 CALL mpprecv( 4, t2sn(1,1,2), imigr ) 1126 IF(l k_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)1127 IF(l k_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)1145 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1146 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 1128 1147 CASE ( 1 ) 1129 1148 CALL mppsend( 3, t2ns(1,1,1), imigr, noso, ml_req1 ) 1130 1149 CALL mpprecv( 4, t2sn(1,1,2), imigr ) 1131 IF(l k_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)1150 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1132 1151 END SELECT 1133 1152 … … 1317 1336 CALL mppsend( 2, t2we(1,1,1), imigr, noea, ml_req1 ) 1318 1337 CALL mpprecv( 1, t2ew(1,1,2), imigr ) 1319 IF(l k_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)1338 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1320 1339 CASE ( 0 ) 1321 1340 CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 ) … … 1323 1342 CALL mpprecv( 1, t2ew(1,1,2), imigr ) 1324 1343 CALL mpprecv( 2, t2we(1,1,2), imigr ) 1325 IF(l k_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)1326 IF(l k_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)1344 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1345 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 1327 1346 CASE ( 1 ) 1328 1347 CALL mppsend( 1, t2ew(1,1,1), imigr, nowe, ml_req1 ) 1329 1348 CALL mpprecv( 2, t2we(1,1,2), imigr ) 1330 IF(l k_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)1349 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1331 1350 END SELECT 1332 1351 #endif … … 1424 1443 CALL mppsend(3,t2p1(1,1,1),imigr,nono, ml_req1) 1425 1444 CALL mpprecv(3,t2p1(1,1,2),imigr) 1426 IF(l k_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)1445 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1427 1446 1428 1447 #endif … … 1453 1472 CALL mppsend(3,t2p1(1,1,1),imigr,nono, ml_req1) 1454 1473 CALL mpprecv(3,t2p1(1,1,2),imigr) 1455 IF(l k_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)1474 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1456 1475 1457 1476 #endif … … 1516 1535 CALL mppsend(2,t2we(1,1,1),imigr,noea, ml_req1) 1517 1536 CALL mpprecv(1,t2ew(1,1,2),imigr) 1518 IF(l k_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)1537 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1519 1538 CASE ( 0 ) 1520 1539 CALL mppsend(1,t2ew(1,1,1),imigr,nowe, ml_req1) … … 1522 1541 CALL mpprecv(1,t2ew(1,1,2),imigr) 1523 1542 CALL mpprecv(2,t2we(1,1,2),imigr) 1524 IF(l k_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)1525 IF(l k_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)1543 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1544 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 1526 1545 1527 1546 CASE ( 1 ) 1528 1547 CALL mppsend(1,t2ew(1,1,1),imigr,nowe, ml_req1) 1529 1548 CALL mpprecv(2,t2we(1,1,2),imigr) 1530 IF(l k_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)1549 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1531 1550 1532 1551 END SELECT … … 1609 1628 CALL mppsend(4,t2sn(1,1,1),imigr,nono, ml_req1) 1610 1629 CALL mpprecv(3,t2ns(1,1,2),imigr) 1611 IF(l k_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)1630 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1612 1631 1613 1632 CASE ( 0 ) … … 1616 1635 CALL mpprecv(3,t2ns(1,1,2),imigr) 1617 1636 CALL mpprecv(4,t2sn(1,1,2),imigr) 1618 IF(l k_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)1619 IF(l k_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)1637 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1638 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 1620 1639 1621 1640 CASE ( 1 ) 1622 1641 CALL mppsend(3,t2ns(1,1,1),imigr,noso, ml_req1) 1623 1642 CALL mpprecv(4,t2sn(1,1,2),imigr) 1624 IF(l k_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)1643 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 1625 1644 END SELECT 1626 1645 … … 1675 1694 INTEGER :: iflag 1676 1695 1677 IF(lk_bsend) THEN 1678 CALL mpi_bsend( pmess, kbytes, mpi_double_precision, kdest, ktyp, & 1679 & mpi_comm_world, iflag ) 1680 ELSEIF (lk_isend) THEN 1681 ! Carefull here : one more argument for mpi_isend : the mpi request identifier.. 1682 CALL mpi_isend( pmess, kbytes, mpi_double_precision, kdest, ktyp, & 1683 & mpi_comm_world, md_req, iflag ) 1684 ELSE 1685 CALL mpi_send( pmess, kbytes, mpi_double_precision, kdest, ktyp, & 1686 & mpi_comm_world, iflag ) 1687 ENDIF 1696 SELECT CASE ( c_mpi_send ) 1697 CASE ( 'S' ) ! Standard mpi send (blocking) 1698 CALL mpi_send ( pmess, kbytes, mpi_double_precision, kdest, ktyp, & 1699 & mpi_comm_world, iflag ) 1700 CASE ( 'B' ) ! Buffer mpi send (blocking) 1701 CALL mpi_bsend( pmess, kbytes, mpi_double_precision, kdest, ktyp, & 1702 & mpi_comm_world, iflag ) 1703 CASE ( 'I' ) ! Immediate mpi send (non-blocking send) 1704 ! Be carefull, one more argument here : the mpi request identifier.. 1705 CALL mpi_isend( pmess, kbytes, mpi_double_precision, kdest, ktyp, & 1706 & mpi_comm_world, md_req, iflag ) 1707 END SELECT 1688 1708 #endif 1689 1709 … … 2934 2954 CALL mppsend(2,t2we(1,1,1),imigr,noea, ml_req1) 2935 2955 CALL mpprecv(1,t2ew(1,1,2),imigr) 2936 IF(l k_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)2956 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 2937 2957 ELSEIF( nbondi == 0 ) THEN 2938 2958 CALL mppsend(1,t2ew(1,1,1),imigr,nowe, ml_req1) … … 2940 2960 CALL mpprecv(1,t2ew(1,1,2),imigr) 2941 2961 CALL mpprecv(2,t2we(1,1,2),imigr) 2942 IF(l k_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)2943 IF(l k_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)2962 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 2963 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 2944 2964 ELSEIF( nbondi == 1 ) THEN 2945 2965 CALL mppsend(1,t2ew(1,1,1),imigr,nowe, ml_req1) 2946 2966 CALL mpprecv(2,t2we(1,1,2),imigr) 2947 IF(l k_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)2967 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 2948 2968 ENDIF 2949 2969 #endif … … 3005 3025 CALL mppsend(4,t2sn(1,1,1),imigr,nono, ml_req1) 3006 3026 CALL mpprecv(3,t2ns(1,1,2),imigr) 3007 IF(l k_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)3027 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 3008 3028 ELSEIF( nbondj == 0 ) THEN 3009 3029 CALL mppsend(3,t2ns(1,1,1),imigr,noso, ml_req1) … … 3011 3031 CALL mpprecv(3,t2ns(1,1,2),imigr) 3012 3032 CALL mpprecv(4,t2sn(1,1,2),imigr) 3013 IF(l k_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)3014 IF(l k_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err)3033 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 3034 IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 3015 3035 ELSEIF( nbondj == 1 ) THEN 3016 3036 CALL mppsend(3,t2ns(1,1,1),imigr,noso, ml_req1) 3017 3037 CALL mpprecv(4,t2sn(1,1,2),imigr) 3018 IF(l k_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err)3038 IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 3019 3039 ENDIF 3020 3040
Note: See TracChangeset
for help on using the changeset viewer.
