Changeset 14037 for NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/OCE/LBC/lib_mpp.F90
- Timestamp:
- 2020-12-03T12:20:38+01:00 (3 years ago)
- Location:
- NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/LBC/lib_mpp.F90 (modified) (12 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG
- Property svn:externals
-
old new 8 8 9 9 # SETTE 10 ^/utils/CI/sette @13292sette10 ^/utils/CI/sette_wave@13990 sette
-
- Property svn:externals
-
NEMO/branches/2020/dev_r13333_KERNEL-08_techene_gm_HPG_SPG/src/OCE/LBC/lib_mpp.F90
r13286 r14037 66 66 PUBLIC mppscatter, mppgather 67 67 PUBLIC mpp_ini_znl 68 PUBLIC mpp_ini_nc 68 69 PUBLIC mppsend, mpprecv ! needed by TAM and ICB routines 69 70 PUBLIC mppsend_sp, mpprecv_sp ! needed by TAM and ICB routines … … 73 74 PUBLIC tic_tac 74 75 #if ! defined key_mpp_mpi 76 PUBLIC MPI_wait 75 77 PUBLIC MPI_Wtime 76 78 #endif … … 115 117 #else 116 118 INTEGER, PUBLIC, PARAMETER :: MPI_STATUS_SIZE = 1 119 INTEGER, PUBLIC, PARAMETER :: MPI_REAL = 4 117 120 INTEGER, PUBLIC, PARAMETER :: MPI_DOUBLE_PRECISION = 8 118 121 LOGICAL, PUBLIC, PARAMETER :: lk_mpp = .FALSE. !: mpp flag … … 135 138 INTEGER :: ndim_rank_znl ! number of processors on the same zonal average 136 139 INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: nrank_znl ! dimension ndim_rank_znl, number of the procs into the same znl domain 140 141 ! variables used for MPI3 neighbourhood collectives 142 INTEGER, PUBLIC :: mpi_nc_com ! MPI3 neighbourhood collectives communicator 143 INTEGER, PUBLIC :: mpi_nc_all_com ! MPI3 neighbourhood collectives communicator (with diagionals) 137 144 138 145 ! North fold condition in mpp_mpi with jpni > 1 (PUBLIC for TAM) … … 509 516 ALLOCATE(todelay(idvar)%y1d(isz)) 510 517 todelay(idvar)%y1d(:) = CMPLX(todelay(idvar)%z1d(:), 0., wp) ! create %y1d, complex variable needed by mpi_sumdd 518 ndelayid(idvar) = MPI_REQUEST_NULL ! initialised request to a valid value 511 519 END IF 512 520 ENDIF … … 516 524 ALLOCATE(todelay(idvar)%z1d(isz), todelay(idvar)%y1d(isz)) ! allocate also %z1d as used for the restart 517 525 CALL mpi_allreduce( y_in(:), todelay(idvar)%y1d(:), isz, MPI_DOUBLE_COMPLEX, mpi_sumdd, ilocalcomm, ierr ) ! get %y1d 518 todelay(idvar)%z1d(:) = REAL(todelay(idvar)%y1d(:), wp) ! define %z1d from %y1d519 ENDIF 520 521 IF( ndelayid(idvar) > 0 )CALL mpp_delay_rcv( idvar ) ! make sure %z1d is received526 ndelayid(idvar) = MPI_REQUEST_NULL 527 ENDIF 528 529 CALL mpp_delay_rcv( idvar ) ! make sure %z1d is received 522 530 523 531 ! send back pout from todelay(idvar)%z1d defined at previous call … … 528 536 IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.) 529 537 CALL mpi_allreduce( y_in(:), todelay(idvar)%y1d(:), isz, MPI_DOUBLE_COMPLEX, mpi_sumdd, ilocalcomm, ierr ) 530 ndelayid(idvar) = 1538 ndelayid(idvar) = MPI_REQUEST_NULL 531 539 IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.) 532 540 # else … … 589 597 DEALLOCATE(todelay(idvar)%z1d) 590 598 ndelayid(idvar) = -1 ! do as if we had no restart 599 ELSE 600 ndelayid(idvar) = MPI_REQUEST_NULL 591 601 END IF 592 602 ENDIF … … 596 606 ALLOCATE(todelay(idvar)%z1d(isz)) 597 607 CALL mpi_allreduce( p_in(:), todelay(idvar)%z1d(:), isz, MPI_DOUBLE_PRECISION, mpi_max, ilocalcomm, ierr ) ! get %z1d 598 ENDIF 599 600 IF( ndelayid(idvar) > 0 ) CALL mpp_delay_rcv( idvar ) ! make sure %z1d is received 608 ndelayid(idvar) = MPI_REQUEST_NULL 609 ENDIF 610 611 CALL mpp_delay_rcv( idvar ) ! make sure %z1d is received 601 612 602 613 ! send back pout from todelay(idvar)%z1d defined at previous call … … 604 615 605 616 ! send p_in into todelay(idvar)%z1d with a non-blocking communication 617 ! (PM) Should we get rid of MPI2 option ? MPI3 was release in 2013. Who is still using MPI2 ? 606 618 # if defined key_mpi2 607 619 IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.) 608 CALL mpi_allreduce( p_in(:), todelay(idvar)%z1d(:), isz, MPI_TYPE, mpi_max, ilocalcomm, ndelayid(idvar),ierr )620 CALL mpi_allreduce( p_in(:), todelay(idvar)%z1d(:), isz, MPI_TYPE, mpi_max, ilocalcomm, ierr ) 609 621 IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.) 610 622 # else … … 629 641 !!---------------------------------------------------------------------- 630 642 #if defined key_mpp_mpi 631 IF( ndelayid(kid) /= -2 ) THEN 632 #if ! defined key_mpi2 633 IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.) 634 CALL mpi_wait( ndelayid(kid), MPI_STATUS_IGNORE, ierr ) ! make sure todelay(kid) is received 635 IF( ln_timing ) CALL tic_tac(.FALSE., ld_global = .TRUE.) 636 #endif 637 IF( ASSOCIATED(todelay(kid)%y1d) ) todelay(kid)%z1d(:) = REAL(todelay(kid)%y1d(:), wp) ! define %z1d from %y1d 638 ndelayid(kid) = -2 ! add flag to know that mpi_wait was already called on kid 639 ENDIF 643 IF( ln_timing ) CALL tic_tac( .TRUE., ld_global = .TRUE.) 644 ! test on ndelayid(kid) useless as mpi_wait return immediatly if the request handle is MPI_REQUEST_NULL 645 CALL mpi_wait( ndelayid(kid), MPI_STATUS_IGNORE, ierr ) ! after this ndelayid(kid) = MPI_REQUEST_NULL 646 IF( ln_timing ) CALL tic_tac( .FALSE., ld_global = .TRUE.) 647 IF( ASSOCIATED(todelay(kid)%y1d) ) todelay(kid)%z1d(:) = REAL(todelay(kid)%y1d(:), wp) ! define %z1d from %y1d 640 648 #endif 641 649 END SUBROUTINE mpp_delay_rcv … … 1064 1072 1065 1073 END SUBROUTINE mpp_ini_znl 1074 1075 SUBROUTINE mpp_ini_nc 1076 !!---------------------------------------------------------------------- 1077 !! *** routine mpp_ini_nc *** 1078 !! 1079 !! ** Purpose : Initialize special communicators for MPI3 neighbourhood 1080 !! collectives 1081 !! 1082 !! ** Method : - Create graph communicators starting from the processes 1083 !! distribution along i and j directions 1084 ! 1085 !! ** output 1086 !! mpi_nc_com = MPI3 neighbourhood collectives communicator 1087 !! mpi_nc_all_com = MPI3 neighbourhood collectives communicator 1088 !! (with diagonals) 1089 !! 1090 !!---------------------------------------------------------------------- 1091 INTEGER, DIMENSION(:), ALLOCATABLE :: ineigh, ineighalls, ineighallr 1092 INTEGER :: ideg, idegalls, idegallr, icont, icont1 1093 INTEGER :: ierr 1094 LOGICAL, PARAMETER :: ireord = .FALSE. 1095 1096 #if defined key_mpp_mpi 1097 1098 ideg = 0 1099 idegalls = 0 1100 idegallr = 0 1101 icont = 0 1102 icont1 = 0 1103 1104 IF (nbondi .eq. 1) THEN 1105 ideg = ideg + 1 1106 ELSEIF (nbondi .eq. -1) THEN 1107 ideg = ideg + 1 1108 ELSEIF (nbondi .eq. 0) THEN 1109 ideg = ideg + 2 1110 ENDIF 1111 1112 IF (nbondj .eq. 1) THEN 1113 ideg = ideg + 1 1114 ELSEIF (nbondj .eq. -1) THEN 1115 ideg = ideg + 1 1116 ELSEIF (nbondj .eq. 0) THEN 1117 ideg = ideg + 2 1118 ENDIF 1119 1120 idegalls = ideg 1121 idegallr = ideg 1122 1123 IF (nones .ne. -1) idegalls = idegalls + 1 1124 IF (nonws .ne. -1) idegalls = idegalls + 1 1125 IF (noses .ne. -1) idegalls = idegalls + 1 1126 IF (nosws .ne. -1) idegalls = idegalls + 1 1127 IF (noner .ne. -1) idegallr = idegallr + 1 1128 IF (nonwr .ne. -1) idegallr = idegallr + 1 1129 IF (noser .ne. -1) idegallr = idegallr + 1 1130 IF (noswr .ne. -1) idegallr = idegallr + 1 1131 1132 ALLOCATE(ineigh(ideg)) 1133 ALLOCATE(ineighalls(idegalls)) 1134 ALLOCATE(ineighallr(idegallr)) 1135 1136 IF (nbondi .eq. 1) THEN 1137 icont = icont + 1 1138 ineigh(icont) = nowe 1139 ineighalls(icont) = nowe 1140 ineighallr(icont) = nowe 1141 ELSEIF (nbondi .eq. -1) THEN 1142 icont = icont + 1 1143 ineigh(icont) = noea 1144 ineighalls(icont) = noea 1145 ineighallr(icont) = noea 1146 ELSEIF (nbondi .eq. 0) THEN 1147 icont = icont + 1 1148 ineigh(icont) = nowe 1149 ineighalls(icont) = nowe 1150 ineighallr(icont) = nowe 1151 icont = icont + 1 1152 ineigh(icont) = noea 1153 ineighalls(icont) = noea 1154 ineighallr(icont) = noea 1155 ENDIF 1156 1157 IF (nbondj .eq. 1) THEN 1158 icont = icont + 1 1159 ineigh(icont) = noso 1160 ineighalls(icont) = noso 1161 ineighallr(icont) = noso 1162 ELSEIF (nbondj .eq. -1) THEN 1163 icont = icont + 1 1164 ineigh(icont) = nono 1165 ineighalls(icont) = nono 1166 ineighallr(icont) = nono 1167 ELSEIF (nbondj .eq. 0) THEN 1168 icont = icont + 1 1169 ineigh(icont) = noso 1170 ineighalls(icont) = noso 1171 ineighallr(icont) = noso 1172 icont = icont + 1 1173 ineigh(icont) = nono 1174 ineighalls(icont) = nono 1175 ineighallr(icont) = nono 1176 ENDIF 1177 1178 icont1 = icont 1179 IF (nosws .ne. -1) THEN 1180 icont = icont + 1 1181 ineighalls(icont) = nosws 1182 ENDIF 1183 IF (noses .ne. -1) THEN 1184 icont = icont + 1 1185 ineighalls(icont) = noses 1186 ENDIF 1187 IF (nonws .ne. -1) THEN 1188 icont = icont + 1 1189 ineighalls(icont) = nonws 1190 ENDIF 1191 IF (nones .ne. -1) THEN 1192 icont = icont + 1 1193 ineighalls(icont) = nones 1194 ENDIF 1195 IF (noswr .ne. -1) THEN 1196 icont1 = icont1 + 1 1197 ineighallr(icont1) = noswr 1198 ENDIF 1199 IF (noser .ne. -1) THEN 1200 icont1 = icont1 + 1 1201 ineighallr(icont1) = noser 1202 ENDIF 1203 IF (nonwr .ne. -1) THEN 1204 icont1 = icont1 + 1 1205 ineighallr(icont1) = nonwr 1206 ENDIF 1207 IF (noner .ne. -1) THEN 1208 icont1 = icont1 + 1 1209 ineighallr(icont1) = noner 1210 ENDIF 1211 1212 CALL MPI_Dist_graph_create_adjacent(mpi_comm_oce, ideg, ineigh, MPI_UNWEIGHTED, ideg, ineigh, MPI_UNWEIGHTED, MPI_INFO_NULL, ireord, mpi_nc_com, ierr) 1213 CALL MPI_Dist_graph_create_adjacent(mpi_comm_oce, idegallr, ineighallr, MPI_UNWEIGHTED, idegalls, ineighalls, MPI_UNWEIGHTED, MPI_INFO_NULL, ireord, mpi_nc_all_com, ierr) 1214 1215 DEALLOCATE (ineigh) 1216 DEALLOCATE (ineighalls) 1217 DEALLOCATE (ineighallr) 1218 #endif 1219 END SUBROUTINE mpp_ini_nc 1220 1066 1221 1067 1222
Note: See TracChangeset
for help on using the changeset viewer.
