Changeset 13561 for NEMO/branches
- Timestamp:
- 2020-10-04T11:18:11+02:00 (3 years ago)
- Location:
- NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src
- Files:
-
- 7 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/ICE/icedyn_rhg_evp.F90
r13295 r13561 184 184 zfmask(ji,jj) = tmask(ji,jj,1) * tmask(ji+1,jj,1) * tmask(ji,jj+1,1) * tmask(ji+1,jj+1,1) 185 185 END_2D 186 CALL lbc_lnk ( 'icedyn_rhg_evp', zfmask, 'F', 1._wp)186 CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', zfmask, 'F', 1._wp) 187 187 188 188 ! Lateral boundary conditions on velocity (modify zfmask) … … 209 209 ENDIF 210 210 END DO 211 CALL lbc_lnk ( 'icedyn_rhg_evp', zfmask, 'F', 1._wp )211 CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', zfmask, 'F', 1._wp ) 212 212 213 213 !------------------------------------------------------------------------------! … … 300 300 301 301 END_2D 302 CALL lbc_lnk_ multi( 'icedyn_rhg_evp', zmf, 'T', 1.0_wp, zdt_m, 'T', 1.0_wp )302 CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', zmf, 'T', 1.0_wp, zdt_m, 'T', 1.0_wp ) 303 303 ! 304 304 ! !== Landfast ice parameterization ==! … … 319 319 tau_icebfr(ji,jj) = - rn_icebfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) ) 320 320 END_2D 321 CALL lbc_lnk ( 'icedyn_rhg_evp', tau_icebfr(:,:), 'T', 1.0_wp )321 CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', tau_icebfr(:,:), 'T', 1.0_wp ) 322 322 ! 323 323 ELSE !-- no landfast … … 395 395 396 396 END_2D 397 CALL lbc_lnk( 'icedyn_rhg_evp', zp_delt, 'T', 1.0_wp ) 398 397 CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', zp_delt, 'T', 1.0_wp ) 399 398 DO_2D( 1, 0, 1, 0 ) 400 399 … … 484 483 ENDIF 485 484 END_2D 486 CALL lbc_lnk ( 'icedyn_rhg_evp', v_ice, 'V', -1.0_wp )485 CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', v_ice, 'V', -1.0_wp ) 487 486 ! 488 487 #if defined key_agrif … … 533 532 ENDIF 534 533 END_2D 535 CALL lbc_lnk ( 'icedyn_rhg_evp', u_ice, 'U', -1.0_wp )534 CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', u_ice, 'U', -1.0_wp ) 536 535 ! 537 536 #if defined key_agrif … … 584 583 ENDIF 585 584 END_2D 586 CALL lbc_lnk ( 'icedyn_rhg_evp', u_ice, 'U', -1.0_wp )585 CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', u_ice, 'U', -1.0_wp ) 587 586 ! 588 587 #if defined key_agrif … … 633 632 ENDIF 634 633 END_2D 635 CALL lbc_lnk ( 'icedyn_rhg_evp', v_ice, 'V', -1.0_wp )634 CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', v_ice, 'V', -1.0_wp ) 636 635 ! 637 636 #if defined key_agrif … … 694 693 695 694 END_2D 696 CALL lbc_lnk_ multi( 'icedyn_rhg_evp', pshear_i, 'T', 1.0_wp, pdivu_i, 'T', 1.0_wp, pdelta_i, 'T', 1.0_wp )695 CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', pshear_i, 'T', 1.0_wp, pdivu_i, 'T', 1.0_wp, pdelta_i, 'T', 1.0_wp ) 697 696 698 697 ! --- Store the stress tensor for the next time step --- ! 699 CALL lbc_lnk_ multi( 'icedyn_rhg_evp', zs1, 'T', 1.0_wp, zs2, 'T', 1.0_wp, zs12, 'F', 1.0_wp )698 CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', zs1, 'T', 1.0_wp, zs2, 'T', 1.0_wp, zs12, 'F', 1.0_wp ) 700 699 pstress1_i (:,:) = zs1 (:,:) 701 700 pstress2_i (:,:) = zs2 (:,:) … … 714 713 & iom_use('utau_bi') .OR. iom_use('vtau_bi') ) THEN 715 714 ! 716 CALL lbc_lnk_ multi( 'icedyn_rhg_evp', ztaux_oi, 'U', -1.0_wp, ztauy_oi, 'V', -1.0_wp, ztaux_ai, 'U', -1.0_wp, ztauy_ai, 'V', -1.0_wp, &715 CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', ztaux_oi, 'U', -1.0_wp, ztauy_oi, 'V', -1.0_wp, ztaux_ai, 'U', -1.0_wp, ztauy_ai, 'V', -1.0_wp, & 717 716 & ztaux_bi, 'U', -1.0_wp, ztauy_bi, 'V', -1.0_wp ) 718 717 ! … … 752 751 zsig3(ji,jj) = zdum2**2 * ( ( pstress1_i(ji,jj) + strength(ji,jj) )**2 + ( rn_ecc * zshear )**2 ) 753 752 END_2D 754 CALL lbc_lnk_ multi( 'icedyn_rhg_evp', zsig1, 'T', 1.0_wp, zsig2, 'T', 1.0_wp, zsig3, 'T', 1.0_wp )753 CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', zsig1, 'T', 1.0_wp, zsig2, 'T', 1.0_wp, zsig3, 'T', 1.0_wp ) 755 754 ! 756 755 CALL iom_put( 'isig1' , zsig1 ) … … 769 768 & iom_use('corstrx') .OR. iom_use('corstry') .OR. iom_use('intstrx') .OR. iom_use('intstry') ) THEN 770 769 ! 771 CALL lbc_lnk_ multi( 'icedyn_rhg_evp', zspgU, 'U', -1.0_wp, zspgV, 'V', -1.0_wp, &770 CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', zspgU, 'U', -1.0_wp, zspgV, 'V', -1.0_wp, & 772 771 & zCorU, 'U', -1.0_wp, zCorV, 'V', -1.0_wp, zfU, 'U', -1.0_wp, zfV, 'V', -1.0_wp ) 773 772 … … 802 801 END_2D 803 802 804 CALL lbc_lnk_ multi( 'icedyn_rhg_evp', zdiag_xmtrp_ice, 'U', -1.0_wp, zdiag_ymtrp_ice, 'V', -1.0_wp, &803 CALL lbc_lnk_nc_multi( 'icedyn_rhg_evp', zdiag_xmtrp_ice, 'U', -1.0_wp, zdiag_ymtrp_ice, 'V', -1.0_wp, & 805 804 & zdiag_xmtrp_snw, 'U', -1.0_wp, zdiag_ymtrp_snw, 'V', -1.0_wp, & 806 805 & zdiag_xatrp , 'U', -1.0_wp, zdiag_yatrp , 'V', -1.0_wp ) -
NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/OCE/DOM/dom_oce.F90
r13286 r13561 87 87 INTEGER, PUBLIC :: noea, nowe !: index of the local neighboring processors in 88 88 INTEGER, PUBLIC :: noso, nono !: east, west, south and north directions 89 INTEGER, PUBLIC :: nones, nonws !: north-east, north-west directions for sending 90 INTEGER, PUBLIC :: noses, nosws !: south-east, south-west directions for sending 91 INTEGER, PUBLIC :: noner, nonwr !: north-east, north-west directions for receiving 92 INTEGER, PUBLIC :: noser, noswr !: south-east, south-west directions for receiving 89 93 INTEGER, PUBLIC :: nidom !: ??? 90 94 -
NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/OCE/LBC/lbc_lnk_nc_generic.h90
r13303 r13561 39 39 & , pt5, cdna5, psgn5, pt6 , cdna6 , psgn6 , pt7 , cdna7 , psgn7 , pt8, cdna8, psgn8 & 40 40 & , pt9, cdna9, psgn9, pt10, cdna10, psgn10, pt11, cdna11, psgn11 & 41 & , kfillmode, pfillval, lsend, lrecv )41 & , kfillmode, pfillval, lsend, lrecv, ncsten ) 42 42 !!--------------------------------------------------------------------- 43 43 CHARACTER(len=*) , INTENT(in ) :: cdname ! name of the calling subroutine … … 51 51 REAL(wp) , OPTIONAL , INTENT(in ) :: pfillval ! background value (used at closed boundaries) 52 52 LOGICAL, DIMENSION(4), OPTIONAL , INTENT(in ) :: lsend, lrecv ! indicate how communications are to be carried out 53 LOGICAL , OPTIONAL , INTENT(in ) :: ncsten 53 54 !! 54 55 INTEGER :: kfld ! number of elements that will be attributed … … 75 76 IF( PRESENT(psgn11) ) CALL ROUTINE_NC_LOAD( pt11, cdna11, psgn11, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 76 77 ! 77 CALL lbc_lnk_nc ( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv )78 CALL lbc_lnk_nc ( cdname, ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv, ncsten ) 78 79 ! 79 80 END SUBROUTINE ROUTINE_MULTI_NC -
NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/OCE/LBC/lib_mpp.F90
r13303 r13561 139 139 ! variables used for MPI3 neighbourhood collectives 140 140 INTEGER, PUBLIC :: mpi_nc_com ! MPI3 neighbourhood collectives communicator 141 INTEGER, PUBLIC , DIMENSION(:), ALLOCATABLE :: nranks141 INTEGER, PUBLIC :: mpi_nc_all_com ! MPI3 neighbourhood collectives communicator (with diagionals) 142 142 143 143 ! North fold condition in mpp_mpi with jpni > 1 (PUBLIC for TAM) … … 1074 1074 !! *** routine mpp_ini_nc *** 1075 1075 !! 1076 !! ** Purpose : Initialize special communicator for MPI3 neighbourhood1076 !! ** Purpose : Initialize special communicators for MPI3 neighbourhood 1077 1077 !! collectives 1078 1078 !! 1079 !! ** Method : - Create a graph communicatorstarting from the processes1079 !! ** Method : - Create graph communicators starting from the processes 1080 1080 !! distribution along i and j directions 1081 1081 ! 1082 1082 !! ** output 1083 1083 !! mpi_nc_com = MPI3 neighbourhood collectives communicator 1084 !! 1085 !!---------------------------------------------------------------------- 1086 INTEGER, DIMENSION(:), ALLOCATABLE :: ineigh 1087 INTEGER :: ideg, icont 1088 INTEGER :: iinfo, ierr 1084 !! mpi_nc_all_com = MPI3 neighbourhood collectives communicator 1085 !! (with diagonals) 1086 !! 1087 !!---------------------------------------------------------------------- 1088 INTEGER, DIMENSION(:), ALLOCATABLE :: ineigh, ineighalls, ineighallr 1089 INTEGER :: ideg, idegalls, idegallr, icont, icont1 1090 INTEGER :: ierr 1089 1091 LOGICAL, PARAMETER :: ireord = .FALSE. 1090 1092 1091 1093 #if defined key_mpp_mpi 1094 1092 1095 ideg = 0 1096 idegalls = 0 1097 idegallr = 0 1093 1098 icont = 0 1099 icont1 = 0 1094 1100 1095 1101 IF (nbondi .eq. 1) THEN … … 1109 1115 ENDIF 1110 1116 1117 idegalls = ideg 1118 idegallr = ideg 1119 1120 IF (nones .ne. -1) idegalls = idegalls + 1 1121 IF (nonws .ne. -1) idegalls = idegalls + 1 1122 IF (noses .ne. -1) idegalls = idegalls + 1 1123 IF (nosws .ne. -1) idegalls = idegalls + 1 1124 IF (noner .ne. -1) idegallr = idegallr + 1 1125 IF (nonwr .ne. -1) idegallr = idegallr + 1 1126 IF (noser .ne. -1) idegallr = idegallr + 1 1127 IF (noswr .ne. -1) idegallr = idegallr + 1 1128 1111 1129 ALLOCATE(ineigh(ideg)) 1130 ALLOCATE(ineighalls(idegalls)) 1131 ALLOCATE(ineighallr(idegallr)) 1112 1132 1113 1133 IF (nbondi .eq. 1) THEN 1114 1134 icont = icont + 1 1115 1135 ineigh(icont) = nowe 1136 ineighalls(icont) = nowe 1137 ineighallr(icont) = nowe 1116 1138 ELSEIF (nbondi .eq. -1) THEN 1117 1139 icont = icont + 1 1118 1140 ineigh(icont) = noea 1141 ineighalls(icont) = noea 1142 ineighallr(icont) = noea 1119 1143 ELSEIF (nbondi .eq. 0) THEN 1120 1144 icont = icont + 1 1121 1145 ineigh(icont) = nowe 1146 ineighalls(icont) = nowe 1147 ineighallr(icont) = nowe 1122 1148 icont = icont + 1 1123 1149 ineigh(icont) = noea 1150 ineighalls(icont) = noea 1151 ineighallr(icont) = noea 1124 1152 ENDIF 1125 1153 … … 1127 1155 icont = icont + 1 1128 1156 ineigh(icont) = noso 1157 ineighalls(icont) = noso 1158 ineighallr(icont) = noso 1129 1159 ELSEIF (nbondj .eq. -1) THEN 1130 1160 icont = icont + 1 1131 1161 ineigh(icont) = nono 1162 ineighalls(icont) = nono 1163 ineighallr(icont) = nono 1132 1164 ELSEIF (nbondj .eq. 0) THEN 1133 1165 icont = icont + 1 1134 1166 ineigh(icont) = noso 1167 ineighalls(icont) = noso 1168 ineighallr(icont) = noso 1135 1169 icont = icont + 1 1136 1170 ineigh(icont) = nono 1171 ineighalls(icont) = nono 1172 ineighallr(icont) = nono 1173 ENDIF 1174 1175 icont1 = icont 1176 IF (nosws .ne. -1) THEN 1177 icont = icont + 1 1178 ineighalls(icont) = nosws 1179 ENDIF 1180 IF (noses .ne. -1) THEN 1181 icont = icont + 1 1182 ineighalls(icont) = noses 1183 ENDIF 1184 IF (nonws .ne. -1) THEN 1185 icont = icont + 1 1186 ineighalls(icont) = nonws 1187 ENDIF 1188 IF (nones .ne. -1) THEN 1189 icont = icont + 1 1190 ineighalls(icont) = nones 1191 ENDIF 1192 IF (noswr .ne. -1) THEN 1193 icont1 = icont1 + 1 1194 ineighallr(icont1) = noswr 1195 ENDIF 1196 IF (noser .ne. -1) THEN 1197 icont1 = icont1 + 1 1198 ineighallr(icont1) = noser 1199 ENDIF 1200 IF (nonwr .ne. -1) THEN 1201 icont1 = icont1 + 1 1202 ineighallr(icont1) = nonwr 1203 ENDIF 1204 IF (noner .ne. -1) THEN 1205 icont1 = icont1 + 1 1206 ineighallr(icont1) = noner 1137 1207 ENDIF 1138 1208 1139 1209 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) 1210 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) 1211 1140 1212 DEALLOCATE (ineigh) 1213 DEALLOCATE (ineighalls) 1214 DEALLOCATE (ineighallr) 1141 1215 #endif 1142 1216 END SUBROUTINE mpp_ini_nc -
NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/OCE/LBC/mpp_nc_generic.h90
r13303 r13561 41 41 # endif 42 42 43 SUBROUTINE ROUTINE_NC( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, lsend, lrecv )43 SUBROUTINE ROUTINE_NC( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, lsend, lrecv, ncsten ) 44 44 INTEGER , INTENT(in ) :: kfld ! number of pt3d arrays 45 45 ARRAY_TYPE(:,:,:,:,:) ! array or pointer of arrays on which the boundary condition is applied … … 50 50 REAL(wp), OPTIONAL, INTENT(in ) :: pfillval ! background value (used at closed boundaries) 51 51 LOGICAL, DIMENSION(4),OPTIONAL, INTENT(in ) :: lsend, lrecv ! communication with other 4 proc 52 ! 53 INTEGER :: ji, jj, jk, jl, jf ! dummy loop indices 54 INTEGER :: ipi, ipj, ipk, ipl, ipf ! dimension of the input array 55 INTEGER :: ishift, ishift2, idx, idim, icount, isizet, izsnds ! local integers 52 LOGICAL, OPTIONAL, INTENT(in ) :: ncsten ! 5-point or 9-point stencil 53 ! 54 INTEGER :: ji, jj, jk, jl, jf ! dummy loop indices 55 INTEGER :: ipi, ipj, ipk, ipl, ipf ! dimension of the input array 56 INTEGER :: ishift, ishift2, idx, icount, icount1 ! local integers 57 INTEGER :: idims, idimr, isizet, isizets, isizetr, izsnd, izrcv ! local integers 56 58 INTEGER :: ierr 57 59 INTEGER :: ifill_we, ifill_ea, ifill_so, ifill_no 58 60 REAL(wp) :: zland 59 INTEGER , DIMENSION(MPI_STATUS_SIZE) :: istate ! for mpi_isend 60 REAL(PRECISION), DIMENSION(:), ALLOCATABLE :: zsnd, zrcv ! halos arrays 61 INTEGER , DIMENSION(:), ALLOCATABLE :: isizes ! number of elements to be sent/received 62 INTEGER , DIMENSION(:), ALLOCATABLE :: idataty ! datatype of halos arrays 63 INTEGER (KIND=MPI_ADDRESS_KIND), DIMENSION (:), ALLOCATABLE :: idispls ! displacement in halos arrays 61 INTEGER , DIMENSION(MPI_STATUS_SIZE) :: istate ! for mpi_isend 62 REAL(PRECISION), DIMENSION(:), ALLOCATABLE :: zsnd, zrcv ! halos arrays 63 INTEGER , DIMENSION(:), ALLOCATABLE :: isizes ! number of elements to be sent 64 INTEGER , DIMENSION(:), ALLOCATABLE :: isizer ! number of elements to be received 65 INTEGER , DIMENSION(:), ALLOCATABLE :: idatatys, idatatyr ! datatype of halos arrays 66 INTEGER (KIND=MPI_ADDRESS_KIND), DIMENSION (:), ALLOCATABLE :: idispls, idisplr ! displacement in halos arrays 64 67 LOGICAL :: llsend_we, llsend_ea, llsend_no, llsend_so ! communication send 65 68 LOGICAL :: llrecv_we, llrecv_ea, llrecv_no, llrecv_so ! communication receive 66 69 LOGICAL :: lldo_nfd ! do north pole folding 70 LOGICAL :: llncall = .TRUE. ! default: 9-point stencil 67 71 68 72 !!---------------------------------------------------------------------- … … 124 128 END IF 125 129 ! 130 IF(PRESENT(ncsten)) llncall = ncsten 126 131 #if defined PRINT_CAUTION 127 132 ! … … 138 143 ! Allocate local temporary arrays to be sent/received. Fill arrays to be sent 139 144 140 idim = 0 141 izsnds = 0 142 143 IF(llsend_we) idim = idim + 1 144 IF(llsend_ea) idim = idim + 1 145 IF(llsend_so) idim = idim + 1 146 IF(llsend_no) idim = idim + 1 145 idims = 0 146 idimr = 0 147 izsnd = 0 148 izrcv = 0 149 150 IF(llsend_we) idims = idims + 1 151 IF(llsend_ea) idims = idims + 1 152 IF(llsend_so) idims = idims + 1 153 IF(llsend_no) idims = idims + 1 154 155 idimr = idims 156 157 IF(llncall) THEN 158 IF(noswr .ne. -1) idimr = idimr + 1 159 IF(noser .ne. -1) idimr = idimr + 1 160 IF(nonwr .ne. -1) idimr = idimr + 1 161 IF(noner .ne. -1) idimr = idimr + 1 147 162 148 IF(llsend_we) izsnds = izsnds + nn_hls * (jpj - 2*nn_hls) * ipk * ipl * ipf 149 IF(llsend_ea) izsnds = izsnds + nn_hls * (jpj - 2*nn_hls) * ipk * ipl * ipf 150 IF(llsend_so) izsnds = izsnds + (jpi - 2*nn_hls) * nn_hls * ipk * ipl * ipf 151 IF(llsend_no) izsnds = izsnds + (jpi - 2*nn_hls) * nn_hls * ipk * ipl * ipf 152 153 ALLOCATE(zsnd(izsnds)) 154 ALLOCATE(zrcv(izsnds)) 155 ALLOCATE(isizes(idim)) 156 ALLOCATE(idataty(idim)) 157 ALLOCATE(idispls(idim)) 163 IF(nosws .ne. -1) idims = idims + 1 164 IF(noses .ne. -1) idims = idims + 1 165 IF(nonws .ne. -1) idims = idims + 1 166 IF(nones .ne. -1) idims = idims + 1 167 END IF 168 169 IF(llsend_we) izsnd = izsnd + nn_hls * (jpj - 2*nn_hls) * ipk * ipl * ipf 170 IF(llsend_ea) izsnd = izsnd + nn_hls * (jpj - 2*nn_hls) * ipk * ipl * ipf 171 IF(llsend_so) izsnd = izsnd + (jpi - 2*nn_hls) * nn_hls * ipk * ipl * ipf 172 IF(llsend_no) izsnd = izsnd + (jpi - 2*nn_hls) * nn_hls * ipk * ipl * ipf 173 174 izrcv = izsnd 175 176 IF(llncall) THEN 177 IF(noswr .ne. -1) izrcv = izrcv + nn_hls * nn_hls * ipk * ipl * ipf 178 IF(noser .ne. -1) izrcv = izrcv + nn_hls * nn_hls * ipk * ipl * ipf 179 IF(nonwr .ne. -1) izrcv = izrcv + nn_hls * nn_hls * ipk * ipl * ipf 180 IF(noner .ne. -1) izrcv = izrcv + nn_hls * nn_hls * ipk * ipl * ipf 181 182 IF(nosws .ne. -1) izsnd = izsnd + nn_hls * nn_hls * ipk * ipl * ipf 183 IF(noses .ne. -1) izsnd = izsnd + nn_hls * nn_hls * ipk * ipl * ipf 184 IF(nonws .ne. -1) izsnd = izsnd + nn_hls * nn_hls * ipk * ipl * ipf 185 IF(nones .ne. -1) izsnd = izsnd + nn_hls * nn_hls * ipk * ipl * ipf 186 END IF 187 188 ALLOCATE(zsnd(izsnd)) 189 ALLOCATE(zrcv(izrcv)) 190 ALLOCATE(isizes(idims)) 191 ALLOCATE(isizer(idimr)) 192 ALLOCATE(idatatys(idims)) 193 ALLOCATE(idatatyr(idimr)) 194 ALLOCATE(idispls(idims)) 195 ALLOCATE(idisplr(idimr)) 158 196 159 197 zrcv(:)=-1 160 198 zsnd(:)=-1 161 199 isizes(:) = 0 200 isizer(:) = 0 162 201 idispls(:) = 0 202 idisplr(:) = 0 163 203 isizet = 0 164 204 … … 204 244 END IF 205 245 206 207 246 IF(llsend_no) THEN 208 247 ishift = jpj-2*nn_hls … … 219 258 END IF 220 259 221 idataty(:) = MPI_TYPE 222 223 IF( ln_timing ) CALL tic_tac(.TRUE.) 224 225 CALL mpi_neighbor_alltoallw (zsnd, isizes, idispls, idataty, zrcv, isizes, idispls, idataty, mpi_nc_com, ierr) 226 227 IF( ln_timing ) CALL tic_tac(.FALSE.) 260 isizer(:) = isizes(:) 261 idisplr(:) = idispls(:) 262 263 icount1 = icount 264 isizets = isizet 265 isizetr = isizet 266 267 IF(llncall) THEN 268 IF(noswr .ne. -1) THEN 269 isizer(icount1) = nn_hls * nn_hls * ipk * ipl * ipf 270 IF(icount1 .gt. 1) isizetr = isizetr + isizer(icount1 - 1) 271 idisplr(icount1) = jpbyt*isizetr 272 icount1 = icount1 + 1 273 END IF 274 IF(noser .ne. -1) THEN 275 isizer(icount1) = nn_hls * nn_hls * ipk * ipl * ipf 276 IF(icount1 .gt. 1) isizetr = isizetr + isizer(icount1 - 1) 277 idisplr(icount1) = jpbyt*isizetr 278 icount1 = icount1 + 1 279 END IF 280 IF(nonwr .ne. -1) THEN 281 isizer(icount1) = nn_hls * nn_hls * ipk * ipl * ipf 282 IF(icount1 .gt. 1) isizetr = isizetr + isizer(icount1 - 1) 283 idisplr(icount1) = jpbyt*isizetr 284 icount1 = icount1 + 1 285 END IF 286 IF(noner .ne. -1) THEN 287 isizer(icount1) = nn_hls * nn_hls * ipk * ipl * ipf 288 IF(icount1 .gt. 1) isizetr = isizetr + isizer(icount1 - 1) 289 idisplr(icount1) = jpbyt*isizetr 290 icount1 = icount1 + 1 291 END IF 292 293 IF(nosws .ne. -1) THEN 294 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, nn_hls 295 zsnd(idx) = ARRAY_IN(nn_hls+ji,nn_hls+jj,jk,jl,jf) 296 idx = idx + 1 297 END DO ; END DO ; END DO ; END DO ; END DO 298 299 isizes(icount) = nn_hls * nn_hls * ipk * ipl * ipf 300 IF(icount .gt. 1) isizets = isizets + isizes(icount - 1) 301 idispls(icount) = jpbyt*isizets 302 icount = icount + 1 303 END IF 304 IF(noses .ne. -1) THEN 305 ishift = jpi-2*nn_hls 306 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, nn_hls 307 zsnd(idx) = ARRAY_IN(ji+ishift,nn_hls+jj,jk,jl,jf) 308 idx = idx + 1 309 END DO ; END DO ; END DO ; END DO ; END DO 310 311 isizes(icount) = nn_hls * nn_hls * ipk * ipl * ipf 312 IF(icount .gt. 1) isizets = isizets + isizes(icount - 1) 313 idispls(icount) = jpbyt*isizets 314 icount = icount + 1 315 END IF 316 IF(nonws .ne. -1) THEN 317 ishift = jpj-2*nn_hls 318 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, nn_hls 319 zsnd(idx) = ARRAY_IN(nn_hls+ji,jj+ishift,jk,jl,jf) 320 idx = idx + 1 321 END DO ; END DO ; END DO ; END DO ; END DO 322 323 isizes(icount) = nn_hls * nn_hls * ipk * ipl * ipf 324 IF(icount .gt. 1) isizets = isizets + isizes(icount - 1) 325 idispls(icount) = jpbyt*isizets 326 icount = icount + 1 327 END IF 328 IF(nones .ne. -1) THEN 329 ishift = jpi-2*nn_hls 330 ishift2 = jpj-2*nn_hls 331 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, nn_hls 332 zsnd(idx) = ARRAY_IN(ji+ishift,jj+ishift2,jk,jl,jf) 333 idx = idx + 1 334 END DO ; END DO ; END DO ; END DO ; END DO 335 336 isizes(icount) = nn_hls * nn_hls * ipk * ipl * ipf 337 IF(icount .gt. 1) isizets = isizets + isizes(icount - 1) 338 idispls(icount) = jpbyt*isizets 339 icount = icount + 1 340 END IF 341 END IF 342 343 idatatys(:) = MPI_TYPE 344 idatatyr(:) = MPI_TYPE 345 346 IF(llncall) THEN 347 IF( ln_timing ) CALL tic_tac(.TRUE.) 348 CALL mpi_neighbor_alltoallw (zsnd, isizes, idispls, idatatys, zrcv, isizer, idisplr, idatatyr, mpi_nc_all_com, ierr) 349 IF( ln_timing ) CALL tic_tac(.FALSE.) 350 ELSE 351 IF( ln_timing ) CALL tic_tac(.TRUE.) 352 CALL mpi_neighbor_alltoallw (zsnd, isizes, idispls, idatatys, zrcv, isizer, idisplr, idatatyr, mpi_nc_com, ierr) 353 IF( ln_timing ) CALL tic_tac(.FALSE.) 354 END IF 228 355 229 356 ! --------------------------------------------------- ! … … 337 464 END SELECT 338 465 ENDIF 339 ! ---------------------- 340 ! 2.3 fill southern halo 341 ! ---------------------- 342 SELECT CASE ( ifill_so ) 343 CASE ( jpfillnothing ) ! no filling 344 CASE ( jpfillmpi ) ! use data received by MPI 345 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = nn_hls + 1, jpi - nn_hls 346 ARRAY_IN(ji,jj,jk,jl,jf) = zrcv(idx) ! 1 -> nn_hls 347 idx = idx + 1 348 END DO; END DO ; END DO ; END DO ; END DO 349 CASE ( jpfillperio ) ! use north-south periodicity 350 ishift2 = jpj - 2 * nn_hls 351 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = nn_hls + 1, jpi - nn_hls 352 ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf) 353 END DO; END DO ; END DO ; END DO ; END DO 354 CASE ( jpfillcopy ) ! filling with inner domain values 355 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = nn_hls + 1, jpi - nn_hls 356 ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ji,nn_hls+1,jk,jl,jf) 357 END DO; END DO ; END DO ; END DO ; END DO 358 CASE ( jpfillcst ) ! filling with constant value 359 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = nn_hls + 1, jpi - nn_hls 360 ARRAY_IN(ji,jj,jk,jl,jf) = zland 361 END DO; END DO ; END DO ; END DO ; END DO 362 END SELECT 363 ! ---------------------- 364 ! 2.4 fill northern halo 365 ! ---------------------- 366 ishift = jpj - nn_hls ! fill halo from jj = jpj-nn_hls+1 to jpj 367 SELECT CASE ( ifill_no ) 368 CASE ( jpfillnothing ) ! no filling 369 CASE ( jpfillmpi ) ! use data received by MPI 370 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = nn_hls + 1, jpi - nn_hls 371 ARRAY_IN(ji,ishift+jj,jk,jl,jf) = zrcv(idx) ! jpj-nn_hls+1 -> jpj 372 idx = idx + 1 373 END DO ; END DO ; END DO ; END DO ; END DO 374 CASE ( jpfillperio ) ! use north-south periodicity 375 ishift2 = nn_hls 376 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = nn_hls + 1, jpi - nn_hls 377 ARRAY_IN(ji,ishift+jj,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf) 378 END DO; END DO ; END DO ; END DO ; END DO 379 CASE ( jpfillcopy ) ! filling with inner domain values 380 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = nn_hls + 1, jpi - nn_hls 381 ARRAY_IN(ji,ishift+jj,jk,jl,jf) = ARRAY_IN(ji,ishift,jk,jl,jf) 382 END DO; END DO ; END DO ; END DO ; END DO 383 CASE ( jpfillcst ) ! filling with constant value 384 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = nn_hls + 1, jpi - nn_hls 385 ARRAY_IN(ji,ishift+jj,jk,jl,jf) = zland 386 END DO; END DO ; END DO ; END DO ; END DO 387 END SELECT 466 467 !!! Patch to solve MPI3 bug when we have only two processes rows 468 IF(jpnj .eq. 2) THEN 469 ! ---------------------- 470 ! 2.3 fill northern halo 471 ! ---------------------- 472 ishift = jpj - nn_hls ! fill halo from jj = jpj-nn_hls+1 to jpj 473 SELECT CASE ( ifill_no ) 474 CASE ( jpfillnothing ) ! no filling 475 CASE ( jpfillmpi ) ! use data received by MPI 476 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = nn_hls + 1, jpi - nn_hls 477 ARRAY_IN(ji,ishift+jj,jk,jl,jf) = zrcv(idx) ! jpj-nn_hls+1 -> jpj 478 idx = idx + 1 479 END DO ; END DO ; END DO ; END DO ; END DO 480 CASE ( jpfillperio ) ! use north-south periodicity 481 ishift2 = nn_hls 482 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = nn_hls + 1, jpi - nn_hls 483 ARRAY_IN(ji,ishift+jj,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf) 484 END DO; END DO ; END DO ; END DO ; END DO 485 CASE ( jpfillcopy ) ! filling with inner domain values 486 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = nn_hls + 1, jpi - nn_hls 487 ARRAY_IN(ji,ishift+jj,jk,jl,jf) = ARRAY_IN(ji,ishift,jk,jl,jf) 488 END DO; END DO ; END DO ; END DO ; END DO 489 CASE ( jpfillcst ) ! filling with constant value 490 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = nn_hls + 1, jpi - nn_hls 491 ARRAY_IN(ji,ishift+jj,jk,jl,jf) = zland 492 END DO; END DO ; END DO ; END DO ; END DO 493 END SELECT 494 ! ---------------------- 495 ! 2.4 fill southern halo 496 ! ---------------------- 497 SELECT CASE ( ifill_so ) 498 CASE ( jpfillnothing ) ! no filling 499 CASE ( jpfillmpi ) ! use data received by MPI 500 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = nn_hls + 1, jpi - nn_hls 501 ARRAY_IN(ji,jj,jk,jl,jf) = zrcv(idx) ! 1 -> nn_hls 502 idx = idx + 1 503 END DO; END DO ; END DO ; END DO ; END DO 504 CASE ( jpfillperio ) ! use north-south periodicity 505 ishift2 = jpj - 2 * nn_hls 506 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = nn_hls + 1, jpi - nn_hls 507 ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf) 508 END DO; END DO ; END DO ; END DO ; END DO 509 CASE ( jpfillcopy ) ! filling with inner domain values 510 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = nn_hls + 1, jpi - nn_hls 511 ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ji,nn_hls+1,jk,jl,jf) 512 END DO; END DO ; END DO ; END DO ; END DO 513 CASE ( jpfillcst ) ! filling with constant value 514 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = nn_hls + 1, jpi - nn_hls 515 ARRAY_IN(ji,jj,jk,jl,jf) = zland 516 END DO; END DO ; END DO ; END DO ; END DO 517 END SELECT 518 ELSE 519 ! ---------------------- 520 ! 2.3 fill southern halo 521 ! ---------------------- 522 SELECT CASE ( ifill_so ) 523 CASE ( jpfillnothing ) ! no filling 524 CASE ( jpfillmpi ) ! use data received by MPI 525 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = nn_hls + 1, jpi - nn_hls 526 ARRAY_IN(ji,jj,jk,jl,jf) = zrcv(idx) ! 1 -> nn_hls 527 idx = idx + 1 528 END DO; END DO ; END DO ; END DO ; END DO 529 CASE ( jpfillperio ) ! use north-south periodicity 530 ishift2 = jpj - 2 * nn_hls 531 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = nn_hls + 1, jpi - nn_hls 532 ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf) 533 END DO; END DO ; END DO ; END DO ; END DO 534 CASE ( jpfillcopy ) ! filling with inner domain values 535 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = nn_hls + 1, jpi - nn_hls 536 ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ji,nn_hls+1,jk,jl,jf) 537 END DO; END DO ; END DO ; END DO ; END DO 538 CASE ( jpfillcst ) ! filling with constant value 539 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = nn_hls + 1, jpi - nn_hls 540 ARRAY_IN(ji,jj,jk,jl,jf) = zland 541 END DO; END DO ; END DO ; END DO ; END DO 542 END SELECT 543 ! ---------------------- 544 ! 2.4 fill northern halo 545 ! ---------------------- 546 ishift = jpj - nn_hls ! fill halo from jj = jpj-nn_hls+1 to jpj 547 SELECT CASE ( ifill_no ) 548 CASE ( jpfillnothing ) ! no filling 549 CASE ( jpfillmpi ) ! use data received by MPI 550 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = nn_hls + 1, jpi - nn_hls 551 ARRAY_IN(ji,ishift+jj,jk,jl,jf) = zrcv(idx) ! jpj-nn_hls+1 -> jpj 552 idx = idx + 1 553 END DO ; END DO ; END DO ; END DO ; END DO 554 CASE ( jpfillperio ) ! use north-south periodicity 555 ishift2 = nn_hls 556 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = nn_hls + 1, jpi - nn_hls 557 ARRAY_IN(ji,ishift+jj,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf) 558 END DO; END DO ; END DO ; END DO ; END DO 559 CASE ( jpfillcopy ) ! filling with inner domain values 560 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = nn_hls + 1, jpi - nn_hls 561 ARRAY_IN(ji,ishift+jj,jk,jl,jf) = ARRAY_IN(ji,ishift,jk,jl,jf) 562 END DO; END DO ; END DO ; END DO ; END DO 563 CASE ( jpfillcst ) ! filling with constant value 564 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = nn_hls + 1, jpi - nn_hls 565 ARRAY_IN(ji,ishift+jj,jk,jl,jf) = zland 566 END DO; END DO ; END DO ; END DO ; END DO 567 END SELECT 568 ENDIF 569 570 IF(llncall) THEN 571 572 !!! Patch to solve MPI3 bug when we have only two processes columns 573 IF(jpni .eq. 2) THEN 574 !!! Patch to solve MPI3 bug when we have only two processes rows 575 IF(jpnj .eq. 2) THEN 576 ! --------------------------- 577 ! 2.5 fill east-nouthern halo 578 ! --------------------------- 579 IF(noner .ne. -1) THEN 580 ishift = jpi - nn_hls 581 ishift2 = jpj - nn_hls 582 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, nn_hls 583 ARRAY_IN(ji+ishift,jj+ishift2,jk,jl,jf) = zrcv(idx) 584 idx = idx + 1 585 END DO ; END DO ; END DO ; END DO ; END DO 586 END IF 587 ! --------------------------- 588 ! 2.6 fill west-nouthern halo 589 ! --------------------------- 590 IF(nonwr .ne. -1) THEN 591 ishift = jpj - nn_hls 592 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, nn_hls 593 ARRAY_IN(ji,jj+ishift,jk,jl,jf) = zrcv(idx) 594 idx = idx + 1 595 END DO ; END DO ; END DO ; END DO ; END DO 596 END IF 597 ! --------------------------- 598 ! 2.7 fill east-southern halo 599 ! --------------------------- 600 IF(noser .ne. -1) THEN 601 ishift = jpi - nn_hls 602 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, nn_hls 603 ARRAY_IN(ji+ishift,jj,jk,jl,jf) = zrcv(idx) 604 idx = idx + 1 605 END DO ; END DO ; END DO ; END DO ; END DO 606 END IF 607 ! --------------------------- 608 ! 2.8 fill west-southern halo 609 ! --------------------------- 610 IF(noswr .ne. -1) THEN 611 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, nn_hls 612 ARRAY_IN(ji,jj,jk,jl,jf) = zrcv(idx) 613 idx = idx + 1 614 END DO ; END DO ; END DO ; END DO ; END DO 615 END IF 616 617 ELSE 618 ! --------------------------- 619 ! 2.5 fill east-southern halo 620 ! --------------------------- 621 IF(noser .ne. -1) THEN 622 ishift = jpi - nn_hls 623 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, nn_hls 624 ARRAY_IN(ji+ishift,jj,jk,jl,jf) = zrcv(idx) 625 idx = idx + 1 626 END DO ; END DO ; END DO ; END DO ; END DO 627 END IF 628 ! --------------------------- 629 ! 2.6 fill west-southern halo 630 ! --------------------------- 631 IF(noswr .ne. -1) THEN 632 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, nn_hls 633 ARRAY_IN(ji,jj,jk,jl,jf) = zrcv(idx) 634 idx = idx + 1 635 END DO ; END DO ; END DO ; END DO ; END DO 636 END IF 637 ! --------------------------- 638 ! 2.7 fill east-nouthern halo 639 ! --------------------------- 640 IF(noner .ne. -1) THEN 641 ishift = jpi - nn_hls 642 ishift2 = jpj - nn_hls 643 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, nn_hls 644 ARRAY_IN(ji+ishift,jj+ishift2,jk,jl,jf) = zrcv(idx) 645 idx = idx + 1 646 END DO ; END DO ; END DO ; END DO ; END DO 647 END IF 648 ! --------------------------- 649 ! 2.8 fill west-nouthern halo 650 ! --------------------------- 651 IF(nonwr .ne. -1) THEN 652 ishift = jpj - nn_hls 653 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, nn_hls 654 ARRAY_IN(ji,jj+ishift,jk,jl,jf) = zrcv(idx) 655 idx = idx + 1 656 END DO ; END DO ; END DO ; END DO ; END DO 657 END IF 658 ENDIF 659 ELSE 660 !!! Patch to solve MPI3 bug when we have only two processes rows 661 IF(jpnj .eq. 2) THEN 662 ! --------------------------- 663 ! 2.5 fill west-nouthern halo 664 ! --------------------------- 665 IF(nonwr .ne. -1) THEN 666 ishift = jpj - nn_hls 667 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, nn_hls 668 ARRAY_IN(ji,jj+ishift,jk,jl,jf) = zrcv(idx) 669 idx = idx + 1 670 END DO ; END DO ; END DO ; END DO ; END DO 671 END IF 672 ! --------------------------- 673 ! 2.6 fill east-nouthern halo 674 ! --------------------------- 675 IF(noner .ne. -1) THEN 676 ishift = jpi - nn_hls 677 ishift2 = jpj - nn_hls 678 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, nn_hls 679 ARRAY_IN(ji+ishift,jj+ishift2,jk,jl,jf) = zrcv(idx) 680 idx = idx + 1 681 END DO ; END DO ; END DO ; END DO ; END DO 682 END IF 683 ! --------------------------- 684 ! 2.7 fill west-southern halo 685 ! --------------------------- 686 IF(noswr .ne. -1) THEN 687 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, nn_hls 688 ARRAY_IN(ji,jj,jk,jl,jf) = zrcv(idx) 689 idx = idx + 1 690 END DO ; END DO ; END DO ; END DO ; END DO 691 END IF 692 ! --------------------------- 693 ! 2.8 fill east-southern halo 694 ! --------------------------- 695 IF(noser .ne. -1) THEN 696 ishift = jpi - nn_hls 697 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, nn_hls 698 ARRAY_IN(ji+ishift,jj,jk,jl,jf) = zrcv(idx) 699 idx = idx + 1 700 END DO ; END DO ; END DO ; END DO ; END DO 701 END IF 702 703 ELSE 704 ! --------------------------- 705 ! 2.5 fill west-southern halo 706 ! --------------------------- 707 IF(noswr .ne. -1) THEN 708 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, nn_hls 709 ARRAY_IN(ji,jj,jk,jl,jf) = zrcv(idx) 710 idx = idx + 1 711 END DO ; END DO ; END DO ; END DO ; END DO 712 END IF 713 ! --------------------------- 714 ! 2.6 fill east-southern halo 715 ! --------------------------- 716 IF(noser .ne. -1) THEN 717 ishift = jpi - nn_hls 718 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, nn_hls 719 ARRAY_IN(ji+ishift,jj,jk,jl,jf) = zrcv(idx) 720 idx = idx + 1 721 END DO ; END DO ; END DO ; END DO ; END DO 722 END IF 723 ! --------------------------- 724 ! 2.7 fill west-nouthern halo 725 ! --------------------------- 726 IF(nonwr .ne. -1) THEN 727 ishift = jpj - nn_hls 728 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, nn_hls 729 ARRAY_IN(ji,jj+ishift,jk,jl,jf) = zrcv(idx) 730 idx = idx + 1 731 END DO ; END DO ; END DO ; END DO ; END DO 732 END IF 733 ! --------------------------- 734 ! 2.8 fill east-nouthern halo 735 ! --------------------------- 736 IF(noner .ne. -1) THEN 737 ishift = jpi - nn_hls 738 ishift2 = jpj - nn_hls 739 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1, nn_hls ; DO ji = 1, nn_hls 740 ARRAY_IN(ji+ishift,jj+ishift2,jk,jl,jf) = zrcv(idx) 741 idx = idx + 1 742 END DO ; END DO ; END DO ; END DO ; END DO 743 END IF 744 ENDIF 745 END IF 746 END IF 747 748 388 749 ! 389 750 ! -------------------------------------------- ! … … 394 755 DEALLOCATE( zrcv ) 395 756 DEALLOCATE(isizes) 396 DEALLOCATE(idataty) 757 DEALLOCATE(isizer) 758 DEALLOCATE(idatatys) 759 DEALLOCATE(idatatyr) 397 760 DEALLOCATE(idispls) 761 DEALLOCATE(idisplr) 398 762 ! 399 763 ! ------------------------------- ! -
NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/OCE/LBC/mppini.F90
r13303 r13561 547 547 ij = ijn(narea) 548 548 ! 549 ! set default neighbours550 noso = ii_noso(narea)551 nowe = ii_nowe(narea)552 noea = ii_noea(narea)553 nono = ii_nono(narea)554 549 jpi = ijpi(ii,ij) 555 550 !!$ Nis0 = iis0(ii,ij) … … 563 558 njmpp = ijmppt(ii,ij) 564 559 jpk = jpkglo ! third dim 560 561 ! set default neighbours 562 noso = ii_noso(narea) 563 nowe = ii_nowe(narea) 564 noea = ii_noea(narea) 565 nono = ii_nono(narea) 566 567 nones = -1 568 nonws = -1 569 noses = -1 570 nosws = -1 571 572 noner = -1 573 nonwr = -1 574 noser = -1 575 noswr = -1 576 577 IF((nbondi .eq. -1) .or. (nbondi .eq. 0)) THEN ! east neighbour exists 578 IF(ibondj(iin(noea+1),ijn(noea+1)) .eq. 0) THEN 579 nones = ii_nono(noea+1) ! east neighbour has north and south neighbours 580 noses = ii_noso(noea+1) 581 ELSEIF(ibondj(iin(noea+1),ijn(noea+1)) .eq. -1) THEN 582 nones = ii_nono(noea+1) ! east neighbour has north neighbour 583 ELSEIF(ibondj(iin(noea+1),ijn(noea+1)) .eq. 1) THEN 584 noses = ii_noso(noea+1) ! east neighbour has south neighbour 585 END IF 586 END IF 587 IF((nbondi .eq. 1) .or. (nbondi .eq. 0)) THEN ! west neighbour exists 588 IF(ibondj(iin(nowe+1),ijn(nowe+1)) .eq. 0) THEN 589 nonws = ii_nono(nowe+1) ! west neighbour has north and south neighbours 590 nosws = ii_noso(nowe+1) 591 ELSEIF(ibondj(iin(nowe+1),ijn(nowe+1)) .eq. -1) THEN 592 nonws = ii_nono(nowe+1) ! west neighbour has north neighbour 593 ELSEIF(ibondj(iin(nowe+1),ijn(nowe+1)) .eq. 1) THEN 594 nosws = ii_noso(nowe+1) ! west neighbour has north neighbour 595 END IF 596 END IF 597 598 IF((nbondj .eq. -1) .or. (nbondj .eq. 0)) THEN ! north neighbour exists 599 IF(ibondi(iin(nono+1),ijn(nono+1)) .eq. 0) THEN 600 noner = ii_noea(nono+1) ! north neighbour has east and west neighbours 601 nonwr = ii_nowe(nono+1) 602 ELSEIF(ibondi(iin(nono+1),ijn(nono+1)) .eq. -1) THEN 603 noner = ii_noea(nono+1) ! north neighbour has east neighbour 604 ELSEIF(ibondi(iin(nono+1),ijn(nono+1)) .eq. 1) THEN 605 nonwr = ii_nowe(nono+1) ! north neighbour has west neighbour 606 END IF 607 END IF 608 IF((nbondj .eq. 1) .or. (nbondj .eq. 0)) THEN ! south neighbour exists 609 IF(ibondi(iin(noso+1),ijn(noso+1)) .eq. 0) THEN 610 noser = ii_noea(noso+1) ! south neighbour has east and west neighbours 611 noswr = ii_nowe(noso+1) 612 ELSEIF(ibondi(iin(noso+1),ijn(noso+1)) .eq. -1) THEN 613 noser = ii_noea(noso+1) ! south neighbour has east neighbour 614 ELSEIF(ibondi(iin(noso+1),ijn(noso+1)) .eq. 1) THEN 615 noswr = ii_nowe(noso+1) ! south neighbour has west neighbour 616 END IF 617 END IF 618 565 619 ! 566 620 CALL init_doloop ! set start/end indices of do-loop, depending on the halo width value (nn_hls) -
NEMO/branches/2020/dev_r13296_HPC-07_mocavero_mpi3/src/OCE/TRA/traadv_fct.F90
r13303 r13561 97 97 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 98 98 ENDIF 99 99 100 !! -- init to 0 100 101 zwi(:,:,:) = 0._wp … … 439 440 END_2D 440 441 END DO 441 CALL lbc_lnk_nc_multi( 'traadv_fct', zbetup, 'T', 1.0_wp , zbetdo, 'T', 1.0_wp ) ! lateral boundary cond. (unchanged sign)442 CALL lbc_lnk_nc_multi( 'traadv_fct', zbetup, 'T', 1.0_wp , zbetdo, 'T', 1.0_wp ) ! lateral boundary cond. (unchanged sign) 442 443 443 444 ! 3. monotonic flux in the i & j direction (paa & pbb) … … 461 462 pcc(ji,jj,jk+1) = pcc(ji,jj,jk+1) * ( zc * za + ( 1._wp - zc) * zb ) 462 463 END_3D 463 CALL lbc_lnk_nc_multi( 'traadv_fct', paa, 'U', -1.0_wp , pbb, 'V', -1.0_wp ) ! lateral boundary condition (changed sign)464 CALL lbc_lnk_nc_multi( 'traadv_fct', paa, 'U', -1.0_wp , pbb, 'V', -1.0_wp ) ! lateral boundary condition (changed sign) 464 465 ! 465 466 END SUBROUTINE nonosc
Note: See TracChangeset
for help on using the changeset viewer.