- Timestamp:
- 2021-04-07T15:48:38+02:00 (3 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_14237_KERNEL-01_IMMERSE_SEAMOUNT/src/OCE/LBC/lib_mpp.F90
r14328 r14676 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 … … 107 110 END INTERFACE 108 111 112 TYPE, PUBLIC :: PTR_4D_sp !: array of 4D pointers (used in lbclnk and lbcnfd) 113 REAL(sp), DIMENSION (:,:,:,:), POINTER :: pt4d 114 END TYPE PTR_4D_sp 115 116 TYPE, PUBLIC :: PTR_4D_dp !: array of 4D pointers (used in lbclnk and lbcnfd) 117 REAL(dp), DIMENSION (:,:,:,:), POINTER :: pt4d 118 END TYPE PTR_4D_dp 119 109 120 !! ========================= !! 110 121 !! MPI variable definition !! 111 122 !! ========================= !! 112 123 #if ! defined key_mpi_off 113 !$AGRIF_DO_NOT_TREAT114 INCLUDE 'mpif.h'115 !$AGRIF_END_DO_NOT_TREAT116 124 LOGICAL, PUBLIC, PARAMETER :: lk_mpp = .TRUE. !: mpp flag 117 125 #else … … 130 138 INTEGER :: MPI_SUMDD 131 139 140 ! Neighbourgs informations 141 INTEGER, PARAMETER, PUBLIC :: n_hlsmax = 3 142 INTEGER, DIMENSION( 8), PUBLIC :: mpinei !: 8-neighbourg MPI indexes (starting at 0, -1 if no neighbourg) 143 INTEGER, DIMENSION(n_hlsmax,8), PUBLIC :: mpiSnei !: 8-neighbourg Send MPI indexes (starting at 0, -1 if no neighbourg) 144 INTEGER, DIMENSION(n_hlsmax,8), PUBLIC :: mpiRnei !: 8-neighbourg Recv MPI indexes (starting at 0, -1 if no neighbourg) 145 INTEGER, PARAMETER, PUBLIC :: jpwe = 1 !: WEst 146 INTEGER, PARAMETER, PUBLIC :: jpea = 2 !: EAst 147 INTEGER, PARAMETER, PUBLIC :: jpso = 3 !: SOuth 148 INTEGER, PARAMETER, PUBLIC :: jpno = 4 !: NOrth 149 INTEGER, PARAMETER, PUBLIC :: jpsw = 5 !: South-West 150 INTEGER, PARAMETER, PUBLIC :: jpse = 6 !: South-East 151 INTEGER, PARAMETER, PUBLIC :: jpnw = 7 !: North-West 152 INTEGER, PARAMETER, PUBLIC :: jpne = 8 !: North-East 153 154 LOGICAL, DIMENSION(8), PUBLIC :: l_SelfPerio ! should we explicitely take care of I/J periodicity 155 LOGICAL, PUBLIC :: l_IdoNFold 156 132 157 ! 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 average158 INTEGER, PUBLIC :: ncomm_znl !: communicator made by the processors on the same zonal average 159 LOGICAL, PUBLIC :: l_znl_root !: True on the 'left'most processor on the same row 160 INTEGER :: ngrp_znl !: group ID for the znl processors 161 INTEGER :: ndim_rank_znl !: number of processors on the same zonal average 137 162 INTEGER, DIMENSION(:), ALLOCATABLE, SAVE :: nrank_znl ! dimension ndim_rank_znl, number of the procs into the same znl domain 138 163 139 164 ! 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)165 INTEGER, DIMENSION(n_hlsmax), PUBLIC :: mpi_nc_com4 ! MPI3 neighbourhood collectives communicator 166 INTEGER, DIMENSION(n_hlsmax), PUBLIC :: mpi_nc_com8 ! MPI3 neighbourhood collectives communicator (with diagionals) 142 167 143 168 ! North fold condition in mpp_mpi with jpni > 1 (PUBLIC for TAM) … … 185 210 186 211 LOGICAL, PUBLIC :: ln_nnogather !: namelist control of northfold comms 187 LOGICAL, PUBLIC :: l_north_nogather = .FALSE. !: internal control of northfold comms 212 INTEGER, PUBLIC :: nn_comm !: namelist control of comms 213 214 INTEGER, PUBLIC, PARAMETER :: jpfillnothing = 1 215 INTEGER, PUBLIC, PARAMETER :: jpfillcst = 2 216 INTEGER, PUBLIC, PARAMETER :: jpfillcopy = 3 217 INTEGER, PUBLIC, PARAMETER :: jpfillperio = 4 218 INTEGER, PUBLIC, PARAMETER :: jpfillmpi = 5 188 219 189 220 !! * Substitutions … … 263 294 INTEGER , INTENT(in ) :: kdest ! receive process number 264 295 INTEGER , INTENT(in ) :: ktyp ! tag of the message 265 INTEGER , INTENT(in 296 INTEGER , INTENT(inout) :: md_req ! argument for isend 266 297 !! 267 298 INTEGER :: iflag … … 292 323 INTEGER , INTENT(in ) :: kdest ! receive process number 293 324 INTEGER , INTENT(in ) :: ktyp ! tag of the message 294 INTEGER , INTENT(in 325 INTEGER , INTENT(inout) :: md_req ! argument for isend 295 326 !! 296 327 INTEGER :: iflag … … 315 346 INTEGER , INTENT(in ) :: kdest ! receive process number 316 347 INTEGER , INTENT(in ) :: ktyp ! tag of the message 317 INTEGER , INTENT(in 348 INTEGER , INTENT(inout) :: md_req ! argument for isend 318 349 !! 319 350 INTEGER :: iflag … … 942 973 LOGICAL, OPTIONAL, INTENT(in) :: ld_abort ! source process number 943 974 LOGICAL :: ll_abort 944 INTEGER :: info 975 INTEGER :: info, ierr 945 976 !!---------------------------------------------------------------------- 946 977 ll_abort = .FALSE. … … 949 980 #if ! defined key_mpi_off 950 981 IF(ll_abort) THEN 951 CALL mpi_abort( MPI_COMM_WORLD )982 CALL mpi_abort( MPI_COMM_WORLD, 123, info ) 952 983 ELSE 953 984 CALL mppsync … … 962 993 SUBROUTINE mpp_comm_free( kcom ) 963 994 !!---------------------------------------------------------------------- 964 INTEGER, INTENT(in ) :: kcom995 INTEGER, INTENT(inout) :: kcom 965 996 !! 966 997 INTEGER :: ierr … … 1071 1102 END SUBROUTINE mpp_ini_znl 1072 1103 1073 SUBROUTINE mpp_ini_nc 1104 1105 SUBROUTINE mpp_ini_nc( khls ) 1074 1106 !!---------------------------------------------------------------------- 1075 1107 !! *** routine mpp_ini_nc *** … … 1082 1114 ! 1083 1115 !! ** 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) 1116 !! mpi_nc_com4 = MPI3 neighbourhood collectives communicator 1117 !! mpi_nc_com8 = MPI3 neighbourhood collectives communicator (with diagonals) 1118 !!---------------------------------------------------------------------- 1119 INTEGER, INTENT(in ) :: khls ! halo size, default = nn_hls 1120 ! 1121 INTEGER, DIMENSION(:), ALLOCATABLE :: iSnei4, iRnei4, iSnei8, iRnei8 1122 INTEGER :: iScnt4, iRcnt4, iScnt8, iRcnt8 1123 INTEGER :: ierr 1124 LOGICAL, PARAMETER :: ireord = .FALSE. 1125 !!---------------------------------------------------------------------- 1126 #if ! defined key_mpi_off && ! defined key_mpi2 1127 1128 iScnt4 = COUNT( mpiSnei(khls,1:4) >= 0 ) 1129 iRcnt4 = COUNT( mpiRnei(khls,1:4) >= 0 ) 1130 iScnt8 = COUNT( mpiSnei(khls,1:8) >= 0 ) 1131 iRcnt8 = COUNT( mpiRnei(khls,1:8) >= 0 ) 1132 1133 ALLOCATE( iSnei4(iScnt4), iRnei4(iRcnt4), iSnei8(iScnt8), iRnei8(iRcnt8) ) ! ok if icnt4 or icnt8 = 0 1134 1135 iSnei4 = PACK( mpiSnei(khls,1:4), mask = mpiSnei(khls,1:4) >= 0 ) 1136 iRnei4 = PACK( mpiRnei(khls,1:4), mask = mpiRnei(khls,1:4) >= 0 ) 1137 iSnei8 = PACK( mpiSnei(khls,1:8), mask = mpiSnei(khls,1:8) >= 0 ) 1138 iRnei8 = PACK( mpiRnei(khls,1:8), mask = mpiRnei(khls,1:8) >= 0 ) 1139 1140 CALL MPI_Dist_graph_create_adjacent( mpi_comm_oce, iScnt4, iSnei4, MPI_UNWEIGHTED, iRcnt4, iRnei4, MPI_UNWEIGHTED, & 1141 & MPI_INFO_NULL, ireord, mpi_nc_com4(khls), ierr ) 1142 CALL MPI_Dist_graph_create_adjacent( mpi_comm_oce, iScnt8, iSnei8, MPI_UNWEIGHTED, iRcnt8, iRnei8, MPI_UNWEIGHTED, & 1143 & MPI_INFO_NULL, ireord, mpi_nc_com8(khls), ierr) 1144 1145 DEALLOCATE( iSnei4, iRnei4, iSnei8, iRnei8 ) 1216 1146 #endif 1217 1147 END SUBROUTINE mpp_ini_nc 1218 1219 1148 1220 1149 … … 1232 1161 !! 1233 1162 !! ** output 1234 !! njmppmax = njmpp for northern procs1235 1163 !! ndim_rank_north = number of processors in the northern line 1236 1164 !! nrank_north (ndim_rank_north) = number of the northern procs. … … 1247 1175 ! 1248 1176 #if ! defined key_mpi_off 1249 njmppmax = MAXVAL( njmppt )1250 1177 ! 1251 1178 ! Look for how many procs on the northern boundary … … 1398 1325 END DO 1399 1326 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))1327 WRITE(numcom,'(A, I4, A, A)') ' - ', 1,' times by subroutine ', TRIM(crname_lbc(n_sequence_lbc)) 1401 1328 END IF 1402 1329 WRITE(numcom,*) ' '
Note: See TracChangeset
for help on using the changeset viewer.
