- Timestamp:
- 2021-12-03T20:32:50+01:00 (3 years ago)
- Location:
- NEMO/branches/2021/dev_r14318_RK3_stage1
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/LBC/lib_mpp.F90 (modified) (21 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r14318_RK3_stage1
- Property svn:externals
-
old new 9 9 10 10 # SETTE 11 ^/utils/CI/sette@14244 sette 11 ^/utils/CI/sette@HEAD sette 12
-
- Property svn:externals
-
NEMO/branches/2021/dev_r14318_RK3_stage1/src/OCE/LBC/lib_mpp.F90
r14275 r15574 49 49 !! mppsync : 50 50 !! mppstop : 51 !! mpp_ini_north : initialisation of north fold51 !! mpp_ini_northgather : initialisation of north fold with gathering of the communications 52 52 !! mpp_lbc_north_icb : alternative to mpp_nfd for extra outer halo with icebergs 53 53 !! mpp_bcast_nml : broadcast/receive namelist character buffer from reading process to all others … … 55 55 USE dom_oce ! ocean space and time domain 56 56 USE in_out_manager ! I/O manager 57 #if ! defined key_mpi_off 58 USE MPI 59 #endif 57 60 58 61 IMPLICIT NONE … … 61 64 PUBLIC ctl_stop, ctl_warn, ctl_opn, ctl_nam, load_nml 62 65 PUBLIC mpp_start, mppstop, mppsync, mpp_comm_free 63 PUBLIC mpp_ini_north 66 PUBLIC mpp_ini_northgather 64 67 PUBLIC mpp_min, mpp_max, mpp_sum, mpp_minloc, mpp_maxloc 65 68 PUBLIC mpp_delay_max, mpp_delay_sum, mpp_delay_rcv … … 73 76 PUBLIC mpp_bcast_nml 74 77 PUBLIC tic_tac 75 #if defined key_mpp_off 76 PUBLIC MPI_wait 77 PUBLIC MPI_Wtime 78 #if defined key_mpi_off 79 PUBLIC MPI_wait 80 PUBLIC MPI_waitall 81 PUBLIC MPI_Wtime 78 82 #endif 79 83 … … 107 111 END INTERFACE 108 112 113 TYPE, PUBLIC :: PTR_4D_sp !: array of 4D pointers (used in lbclnk and lbcnfd) 114 REAL(sp), DIMENSION (:,:,:,:), POINTER :: pt4d 115 END TYPE PTR_4D_sp 116 117 TYPE, PUBLIC :: PTR_4D_dp !: array of 4D pointers (used in lbclnk and lbcnfd) 118 REAL(dp), DIMENSION (:,:,:,:), POINTER :: pt4d 119 END TYPE PTR_4D_dp 120 109 121 !! ========================= !! 110 122 !! MPI variable definition !! 111 123 !! ========================= !! 112 124 #if ! defined key_mpi_off 113 !$AGRIF_DO_NOT_TREAT114 INCLUDE 'mpif.h'115 !$AGRIF_END_DO_NOT_TREAT116 125 LOGICAL, PUBLIC, PARAMETER :: lk_mpp = .TRUE. !: mpp flag 117 126 #else … … 119 128 INTEGER, PUBLIC, PARAMETER :: MPI_REAL = 4 120 129 INTEGER, PUBLIC, PARAMETER :: MPI_DOUBLE_PRECISION = 8 130 INTEGER, PUBLIC, PARAMETER :: MPI_REQUEST_NULL = 1 121 131 LOGICAL, PUBLIC, PARAMETER :: lk_mpp = .FALSE. !: mpp flag 132 INTEGER, PUBLIC, DIMENSION(MPI_STATUS_SIZE) :: MPI_STATUS_IGNORE = 1 ! out from mpi_wait 133 INTEGER, PUBLIC, DIMENSION(MPI_STATUS_SIZE) :: MPI_STATUSES_IGNORE = 1 ! out from mpi_waitall 122 134 #endif 123 135 … … 130 142 INTEGER :: MPI_SUMDD 131 143 144 ! Neighbourgs informations 145 INTEGER, PARAMETER, PUBLIC :: n_hlsmax = 3 146 INTEGER, DIMENSION( 8), PUBLIC :: mpinei !: 8-neighbourg MPI indexes (starting at 0, -1 if no neighbourg) 147 INTEGER, DIMENSION(n_hlsmax,8), PUBLIC :: mpiSnei !: 8-neighbourg Send MPI indexes (starting at 0, -1 if no neighbourg) 148 INTEGER, DIMENSION(n_hlsmax,8), PUBLIC :: mpiRnei !: 8-neighbourg Recv MPI indexes (starting at 0, -1 if no neighbourg) 149 INTEGER, PARAMETER, PUBLIC :: jpwe = 1 !: WEst 150 INTEGER, PARAMETER, PUBLIC :: jpea = 2 !: EAst 151 INTEGER, PARAMETER, PUBLIC :: jpso = 3 !: SOuth 152 INTEGER, PARAMETER, PUBLIC :: jpno = 4 !: NOrth 153 INTEGER, PARAMETER, PUBLIC :: jpsw = 5 !: South-West 154 INTEGER, PARAMETER, PUBLIC :: jpse = 6 !: South-East 155 INTEGER, PARAMETER, PUBLIC :: jpnw = 7 !: North-West 156 INTEGER, PARAMETER, PUBLIC :: jpne = 8 !: North-East 157 158 LOGICAL, DIMENSION(8), PUBLIC :: l_SelfPerio ! should we explicitely take care of I/J periodicity 159 LOGICAL, PUBLIC :: l_IdoNFold 160 132 161 ! variables used for zonal integration 133 INTEGER, PUBLIC :: ncomm_znl !: communicator made by the processors on the same zonal average134 LOGICAL, PUBLIC :: l_znl_root !: True on the 'left'most processor on the same row135 INTEGER :: ngrp_znl !group ID for the znl processors136 INTEGER :: ndim_rank_znl !number of processors on the same zonal average162 INTEGER, PUBLIC :: ncomm_znl !: communicator made by the processors on the same zonal average 163 LOGICAL, PUBLIC :: l_znl_root !: True on the 'left'most processor on the same row 164 INTEGER :: ngrp_znl !: group ID for the znl processors 165 INTEGER :: ndim_rank_znl !: number of processors on the same zonal average 137 166 INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: nrank_znl ! dimension ndim_rank_znl, number of the procs into the same znl domain 138 167 139 168 ! variables used for MPI3 neighbourhood collectives 140 INTEGER, PUBLIC :: mpi_nc_com! MPI3 neighbourhood collectives communicator141 INTEGER, PUBLIC :: mpi_nc_all_com! MPI3 neighbourhood collectives communicator (with diagionals)169 INTEGER, DIMENSION(n_hlsmax), PUBLIC :: mpi_nc_com4 ! MPI3 neighbourhood collectives communicator 170 INTEGER, DIMENSION(n_hlsmax), PUBLIC :: mpi_nc_com8 ! MPI3 neighbourhood collectives communicator (with diagionals) 142 171 143 172 ! North fold condition in mpp_mpi with jpni > 1 (PUBLIC for TAM) … … 185 214 186 215 LOGICAL, PUBLIC :: ln_nnogather !: namelist control of northfold comms 187 LOGICAL, PUBLIC :: l_north_nogather = .FALSE. !: internal control of northfold comms 216 INTEGER, PUBLIC :: nn_comm !: namelist control of comms 217 218 INTEGER, PUBLIC, PARAMETER :: jpfillnothing = 1 219 INTEGER, PUBLIC, PARAMETER :: jpfillcst = 2 220 INTEGER, PUBLIC, PARAMETER :: jpfillcopy = 3 221 INTEGER, PUBLIC, PARAMETER :: jpfillperio = 4 222 INTEGER, PUBLIC, PARAMETER :: jpfillmpi = 5 188 223 189 224 !! * Substitutions … … 263 298 INTEGER , INTENT(in ) :: kdest ! receive process number 264 299 INTEGER , INTENT(in ) :: ktyp ! tag of the message 265 INTEGER , INTENT(in 300 INTEGER , INTENT(inout) :: md_req ! argument for isend 266 301 !! 267 302 INTEGER :: iflag … … 292 327 INTEGER , INTENT(in ) :: kdest ! receive process number 293 328 INTEGER , INTENT(in ) :: ktyp ! tag of the message 294 INTEGER , INTENT(in 329 INTEGER , INTENT(inout) :: md_req ! argument for isend 295 330 !! 296 331 INTEGER :: iflag … … 315 350 INTEGER , INTENT(in ) :: kdest ! receive process number 316 351 INTEGER , INTENT(in ) :: ktyp ! tag of the message 317 INTEGER , INTENT(in 352 INTEGER , INTENT(inout) :: md_req ! argument for isend 318 353 !! 319 354 INTEGER :: iflag … … 942 977 LOGICAL, OPTIONAL, INTENT(in) :: ld_abort ! source process number 943 978 LOGICAL :: ll_abort 944 INTEGER :: info 979 INTEGER :: info, ierr 945 980 !!---------------------------------------------------------------------- 946 981 ll_abort = .FALSE. … … 949 984 #if ! defined key_mpi_off 950 985 IF(ll_abort) THEN 951 CALL mpi_abort( MPI_COMM_WORLD )986 CALL mpi_abort( MPI_COMM_WORLD, 123, info ) 952 987 ELSE 953 988 CALL mppsync … … 962 997 SUBROUTINE mpp_comm_free( kcom ) 963 998 !!---------------------------------------------------------------------- 964 INTEGER, INTENT(in ) :: kcom999 INTEGER, INTENT(inout) :: kcom 965 1000 !! 966 1001 INTEGER :: ierr … … 1071 1106 END SUBROUTINE mpp_ini_znl 1072 1107 1073 SUBROUTINE mpp_ini_nc 1108 1109 SUBROUTINE mpp_ini_nc( khls ) 1074 1110 !!---------------------------------------------------------------------- 1075 1111 !! *** routine mpp_ini_nc *** … … 1082 1118 ! 1083 1119 !! ** output 1084 !! mpi_nc_com = MPI3 neighbourhood collectives communicator 1085 !! mpi_nc_all_com = MPI3 neighbourhood collectives communicator 1086 !! (with diagonals) 1087 !! 1088 !!---------------------------------------------------------------------- 1089 INTEGER, DIMENSION(:), ALLOCATABLE :: ineigh, ineighalls, ineighallr 1090 INTEGER :: ideg, idegalls, idegallr, icont, icont1 1091 INTEGER :: ierr 1092 LOGICAL, PARAMETER :: ireord = .FALSE. 1093 1094 #if ! defined key_mpi_off 1095 1096 ideg = 0 1097 idegalls = 0 1098 idegallr = 0 1099 icont = 0 1100 icont1 = 0 1101 1102 IF (nbondi .eq. 1) THEN 1103 ideg = ideg + 1 1104 ELSEIF (nbondi .eq. -1) THEN 1105 ideg = ideg + 1 1106 ELSEIF (nbondi .eq. 0) THEN 1107 ideg = ideg + 2 1108 ENDIF 1109 1110 IF (nbondj .eq. 1) THEN 1111 ideg = ideg + 1 1112 ELSEIF (nbondj .eq. -1) THEN 1113 ideg = ideg + 1 1114 ELSEIF (nbondj .eq. 0) THEN 1115 ideg = ideg + 2 1116 ENDIF 1117 1118 idegalls = ideg 1119 idegallr = ideg 1120 1121 IF (nones .ne. -1) idegalls = idegalls + 1 1122 IF (nonws .ne. -1) idegalls = idegalls + 1 1123 IF (noses .ne. -1) idegalls = idegalls + 1 1124 IF (nosws .ne. -1) idegalls = idegalls + 1 1125 IF (noner .ne. -1) idegallr = idegallr + 1 1126 IF (nonwr .ne. -1) idegallr = idegallr + 1 1127 IF (noser .ne. -1) idegallr = idegallr + 1 1128 IF (noswr .ne. -1) idegallr = idegallr + 1 1129 1130 ALLOCATE(ineigh(ideg)) 1131 ALLOCATE(ineighalls(idegalls)) 1132 ALLOCATE(ineighallr(idegallr)) 1133 1134 IF (nbondi .eq. 1) THEN 1135 icont = icont + 1 1136 ineigh(icont) = nowe 1137 ineighalls(icont) = nowe 1138 ineighallr(icont) = nowe 1139 ELSEIF (nbondi .eq. -1) THEN 1140 icont = icont + 1 1141 ineigh(icont) = noea 1142 ineighalls(icont) = noea 1143 ineighallr(icont) = noea 1144 ELSEIF (nbondi .eq. 0) THEN 1145 icont = icont + 1 1146 ineigh(icont) = nowe 1147 ineighalls(icont) = nowe 1148 ineighallr(icont) = nowe 1149 icont = icont + 1 1150 ineigh(icont) = noea 1151 ineighalls(icont) = noea 1152 ineighallr(icont) = noea 1153 ENDIF 1154 1155 IF (nbondj .eq. 1) THEN 1156 icont = icont + 1 1157 ineigh(icont) = noso 1158 ineighalls(icont) = noso 1159 ineighallr(icont) = noso 1160 ELSEIF (nbondj .eq. -1) THEN 1161 icont = icont + 1 1162 ineigh(icont) = nono 1163 ineighalls(icont) = nono 1164 ineighallr(icont) = nono 1165 ELSEIF (nbondj .eq. 0) THEN 1166 icont = icont + 1 1167 ineigh(icont) = noso 1168 ineighalls(icont) = noso 1169 ineighallr(icont) = noso 1170 icont = icont + 1 1171 ineigh(icont) = nono 1172 ineighalls(icont) = nono 1173 ineighallr(icont) = nono 1174 ENDIF 1175 1176 icont1 = icont 1177 IF (nosws .ne. -1) THEN 1178 icont = icont + 1 1179 ineighalls(icont) = nosws 1180 ENDIF 1181 IF (noses .ne. -1) THEN 1182 icont = icont + 1 1183 ineighalls(icont) = noses 1184 ENDIF 1185 IF (nonws .ne. -1) THEN 1186 icont = icont + 1 1187 ineighalls(icont) = nonws 1188 ENDIF 1189 IF (nones .ne. -1) THEN 1190 icont = icont + 1 1191 ineighalls(icont) = nones 1192 ENDIF 1193 IF (noswr .ne. -1) THEN 1194 icont1 = icont1 + 1 1195 ineighallr(icont1) = noswr 1196 ENDIF 1197 IF (noser .ne. -1) THEN 1198 icont1 = icont1 + 1 1199 ineighallr(icont1) = noser 1200 ENDIF 1201 IF (nonwr .ne. -1) THEN 1202 icont1 = icont1 + 1 1203 ineighallr(icont1) = nonwr 1204 ENDIF 1205 IF (noner .ne. -1) THEN 1206 icont1 = icont1 + 1 1207 ineighallr(icont1) = noner 1208 ENDIF 1209 1210 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) 1211 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) 1212 1213 DEALLOCATE (ineigh) 1214 DEALLOCATE (ineighalls) 1215 DEALLOCATE (ineighallr) 1120 !! mpi_nc_com4 = MPI3 neighbourhood collectives communicator 1121 !! mpi_nc_com8 = MPI3 neighbourhood collectives communicator (with diagonals) 1122 !!---------------------------------------------------------------------- 1123 INTEGER, INTENT(in ) :: khls ! halo size, default = nn_hls 1124 ! 1125 INTEGER, DIMENSION(:), ALLOCATABLE :: iSnei4, iRnei4, iSnei8, iRnei8 1126 INTEGER :: iScnt4, iRcnt4, iScnt8, iRcnt8 1127 INTEGER :: ierr 1128 LOGICAL, PARAMETER :: ireord = .FALSE. 1129 !!---------------------------------------------------------------------- 1130 #if ! defined key_mpi_off && ! defined key_mpi2 1131 1132 iScnt4 = COUNT( mpiSnei(khls,1:4) >= 0 ) 1133 iRcnt4 = COUNT( mpiRnei(khls,1:4) >= 0 ) 1134 iScnt8 = COUNT( mpiSnei(khls,1:8) >= 0 ) 1135 iRcnt8 = COUNT( mpiRnei(khls,1:8) >= 0 ) 1136 1137 ALLOCATE( iSnei4(iScnt4), iRnei4(iRcnt4), iSnei8(iScnt8), iRnei8(iRcnt8) ) ! ok if icnt4 or icnt8 = 0 1138 1139 iSnei4 = PACK( mpiSnei(khls,1:4), mask = mpiSnei(khls,1:4) >= 0 ) 1140 iRnei4 = PACK( mpiRnei(khls,1:4), mask = mpiRnei(khls,1:4) >= 0 ) 1141 iSnei8 = PACK( mpiSnei(khls,1:8), mask = mpiSnei(khls,1:8) >= 0 ) 1142 iRnei8 = PACK( mpiRnei(khls,1:8), mask = mpiRnei(khls,1:8) >= 0 ) 1143 1144 CALL MPI_Dist_graph_create_adjacent( mpi_comm_oce, iScnt4, iSnei4, MPI_UNWEIGHTED, iRcnt4, iRnei4, MPI_UNWEIGHTED, & 1145 & MPI_INFO_NULL, ireord, mpi_nc_com4(khls), ierr ) 1146 CALL MPI_Dist_graph_create_adjacent( mpi_comm_oce, iScnt8, iSnei8, MPI_UNWEIGHTED, iRcnt8, iRnei8, MPI_UNWEIGHTED, & 1147 & MPI_INFO_NULL, ireord, mpi_nc_com8(khls), ierr) 1148 1149 DEALLOCATE( iSnei4, iRnei4, iSnei8, iRnei8 ) 1216 1150 #endif 1217 1151 END SUBROUTINE mpp_ini_nc 1218 1152 1219 1153 1220 1221 SUBROUTINE mpp_ini_north 1222 !!---------------------------------------------------------------------- 1223 !! *** routine mpp_ini_north *** 1154 SUBROUTINE mpp_ini_northgather 1155 !!---------------------------------------------------------------------- 1156 !! *** routine mpp_ini_northgather *** 1224 1157 !! 1225 1158 !! ** Purpose : Initialize special communicator for north folding … … 1232 1165 !! 1233 1166 !! ** output 1234 !! njmppmax = njmpp for northern procs1235 1167 !! ndim_rank_north = number of processors in the northern line 1236 1168 !! nrank_north (ndim_rank_north) = number of the northern procs. … … 1247 1179 ! 1248 1180 #if ! defined key_mpi_off 1249 njmppmax = MAXVAL( njmppt )1250 1181 ! 1251 1182 ! Look for how many procs on the northern boundary … … 1279 1210 ! 1280 1211 #endif 1281 END SUBROUTINE mpp_ini_north 1212 END SUBROUTINE mpp_ini_northgather 1282 1213 1283 1214 … … 1398 1329 END DO 1399 1330 IF ( crname_lbc(n_sequence_lbc) /= 'already counted' ) THEN 1400 WRITE(numcom,'(A, I4, A, A)') ' - ', 1,' times by subroutine ', TRIM(crname_lbc(n com_rec_max))1331 WRITE(numcom,'(A, I4, A, A)') ' - ', 1,' times by subroutine ', TRIM(crname_lbc(n_sequence_lbc)) 1401 1332 END IF 1402 1333 WRITE(numcom,*) ' ' … … 1474 1405 INTEGER, DIMENSION(MPI_STATUS_SIZE), INTENT( out) :: status 1475 1406 INTEGER , INTENT( out) :: ierror 1407 IF (.FALSE.) THEN ! to avoid compilation warning 1408 status(:) = -1 1409 ierror = -1 1410 ENDIF 1476 1411 END SUBROUTINE mpi_wait 1477 1412 1413 SUBROUTINE mpi_waitall(count, request, status, ierror) 1414 INTEGER , INTENT(in ) :: count 1415 INTEGER, DIMENSION(count) , INTENT(in ) :: request 1416 INTEGER, DIMENSION(MPI_STATUS_SIZE), INTENT( out) :: status 1417 INTEGER , INTENT( out) :: ierror 1418 IF (.FALSE.) THEN ! to avoid compilation warning 1419 status(:) = -1 1420 ierror = -1 1421 ENDIF 1422 END SUBROUTINE mpi_waitall 1478 1423 1479 1424 FUNCTION MPI_Wtime()
Note: See TracChangeset
for help on using the changeset viewer.
