Changeset 14776
- Timestamp:
- 2021-04-30T14:33:41+02:00 (3 years ago)
- Location:
- NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE
- Files:
-
- 6 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/LBC/lbc_lnk_neicoll_generic.h90
r14511 r14776 26 26 INTEGER, DIMENSION(8) :: isizej, ishtSj, ishtRj, ishtPj 27 27 INTEGER, DIMENSION(8) :: ifill, iszall 28 INTEGER, DIMENSION(8) :: jnf 28 29 INTEGER, DIMENSION(:), ALLOCATABLE :: iScnt, iRcnt ! number of elements to be sent/received 29 30 INTEGER, DIMENSION(:), ALLOCATABLE :: iSdpl, iRdpl ! displacement in halos arrays … … 192 193 ! 193 194 idx = 1 195 ! MPI3 bug fix when domain decomposition has 2 columns/rows 196 IF (jpni .eq. 2) THEN 197 IF (jpnj .eq. 2) THEN 198 jnf(1:8) = (/ 2, 1, 4, 3, 8, 7, 6, 5 /) 199 ELSE 200 jnf(1:8) = (/ 2, 1, 3, 4, 6, 5, 8, 7 /) 201 ENDIF 202 ELSE 203 IF (jpnj .eq. 2) THEN 204 jnf(1:8) = (/ 1, 2, 4, 3, 7, 8, 5, 6 /) 205 ELSE 206 jnf(1:8) = (/ 1, 2, 3, 4, 5, 6, 7, 8 /) 207 ENDIF 208 ENDIF 209 194 210 DO jn = 1, 8 195 ishti = ishtRi(jn )196 ishtj = ishtRj(jn )197 SELECT CASE ( ifill(jn ) )211 ishti = ishtRi(jnf(jn)) 212 ishtj = ishtRj(jnf(jn)) 213 SELECT CASE ( ifill(jnf(jn)) ) 198 214 CASE ( jpfillnothing ) ! no filling 199 215 CASE ( jpfillmpi ) ! fill with data received by MPI 200 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jn ) ; DO ji = 1,isizei(jn)216 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jnf(jn)) ; DO ji = 1,isizei(jnf(jn)) 201 217 ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = BUFFRCV(idx) 202 218 idx = idx + 1 203 219 END DO ; END DO ; END DO ; END DO ; END DO 204 220 CASE ( jpfillperio ) ! use periodicity 205 ishti2 = ishtPi(jn )206 ishtj2 = ishtPj(jn )207 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jn ) ; DO ji = 1,isizei(jn)221 ishti2 = ishtPi(jnf(jn)) 222 ishtj2 = ishtPj(jnf(jn)) 223 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jnf(jn)) ; DO ji = 1,isizei(jnf(jn)) 208 224 ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl) 209 225 END DO ; END DO ; END DO ; END DO ; END DO 210 226 CASE ( jpfillcopy ) ! filling with inner domain values 211 ishti2 = ishtSi(jn )212 ishtj2 = ishtSj(jn )213 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jn ) ; DO ji = 1,isizei(jn)227 ishti2 = ishtSi(jnf(jn)) 228 ishtj2 = ishtSj(jnf(jn)) 229 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jnf(jn)) ; DO ji = 1,isizei(jnf(jn)) 214 230 ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl) 215 231 END DO ; END DO ; END DO ; END DO ; END DO 216 232 CASE ( jpfillcst ) ! filling with constant value 217 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jn ) ; DO ji = 1,isizei(jn)233 DO jf = 1, ipf ; DO jl = 1, ipl ; DO jk = 1, ipk ; DO jj = 1,isizej(jnf(jn)) ; DO ji = 1,isizei(jnf(jn)) 218 234 ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = zland 219 235 END DO ; END DO ; END DO ; END DO ; END DO -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/TRA/traadv_cen.F90
r14757 r14776 119 119 ztv(ji,jj,jk) = ( pt(ji ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 120 120 END_3D 121 IF (nn_hls==1) CALL lbc_lnk( 'traadv_cen', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp ) ! Lateral boundary cond.121 IF (nn_hls==1) CALL lbc_lnk( 'traadv_cen', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp, ld4only= .TRUE. ) ! Lateral boundary cond. 122 122 ! 123 123 DO_3D( nn_hls-1, 0, nn_hls-1, 0, 1, jpkm1 ) ! Horizontal advective fluxes -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/TRA/traadv_fct.F90
r14757 r14776 239 239 END DO 240 240 ! NOTE [ comm_cleanup ] : need to change sign to ensure halo 1 - halo 2 compatibility 241 CALL lbc_lnk( 'traadv_fct', zltu, 'T', -1.0_wp , zltv, 'T', -1.0_wp ) ! Lateral boundary cond. (unchanged sgn)241 CALL lbc_lnk( 'traadv_fct', zltu, 'T', -1.0_wp , zltv, 'T', -1.0_wp, ld4only= .TRUE. ) ! Lateral boundary cond. (unchanged sgn) 242 242 ! 243 243 DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) … … 262 262 ztv(ji,jj,jk) = ( pt(ji ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 263 263 END_3D 264 IF (nn_hls==1) CALL lbc_lnk( 'traadv_fct', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp ) ! Lateral boundary cond. (unchanged sgn)264 IF (nn_hls==1) CALL lbc_lnk( 'traadv_fct', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp, ld4only= .TRUE. ) ! Lateral boundary cond. (unchanged sgn) 265 265 ! 266 266 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! Horizontal advective fluxes … … 455 455 END_2D 456 456 END DO 457 IF (nn_hls==1) CALL lbc_lnk( 'traadv_fct', zbetup, 'T', 1.0_wp , zbetdo, 'T', 1.0_wp ) ! lateral boundary cond. (unchanged sign)457 IF (nn_hls==1) CALL lbc_lnk( 'traadv_fct', zbetup, 'T', 1.0_wp , zbetdo, 'T', 1.0_wp, ld4only= .TRUE. ) ! lateral boundary cond. (unchanged sign) 458 458 459 459 ! 3. monotonic flux in the i & j direction (paa & pbb) -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/TRA/traadv_fct_lf.F90
r14511 r14776 270 270 END_2D 271 271 END DO 272 CALL lbc_lnk( 'traadv_fct', zltu_3d, 'T', 1.0_wp , zltv_3d, 'T', 1.0_wp ) ! Lateral boundary cond. (unchanged sgn) 272 IF(nn_hls .EQ. 1) THEN 273 CALL lbc_lnk( 'traadv_fct', zltu_3d, 'T', 1.0_wp , zltv_3d, 'T', 1.0_wp, ld4only= .TRUE. ) ! Lateral boundary cond. (unchanged sgn) 274 ELSE 275 CALL lbc_lnk( 'traadv_fct', zltu_3d, 'T', 1.0_wp , zltv_3d, 'T', 1.0_wp ) ! Lateral boundary cond. (unchanged sgn) 276 ENDIF 273 277 ! ! 274 278 DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/TRA/traadv_qck.F90
r14757 r14776 149 149 zfd(ji,jj,jk) = pt(ji+1,jj,jk,jn,Kbb) ! Downstream in the x-direction for the tracer 150 150 END_3D 151 IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions151 IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, ld4only= .TRUE. ) ! Lateral boundary conditions 152 152 153 153 ! … … 176 176 zfu(ji,jj,jk) = tmask(ji-1,jj,jk) + tmask(ji,jj,jk) + tmask(ji+1,jj,jk) - 2. 177 177 END_3D 178 IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions178 IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp, ld4only= .TRUE. ) ! Lateral boundary conditions 179 179 180 180 ! … … 239 239 END_2D 240 240 END DO 241 IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions241 IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, ld4only= .TRUE. ) ! Lateral boundary conditions 242 242 243 243 ! … … 268 268 zfu(ji,jj,jk) = tmask(ji,jj-1,jk) + tmask(ji,jj,jk) + tmask(ji,jj+1,jk) - 2. 269 269 END_3D 270 IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp ) !--- Lateral boundary conditions270 IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp, ld4only= .TRUE. ) !--- Lateral boundary conditions 271 271 ! 272 272 ! Tracer flux on the x-direction -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/TRA/traadv_ubs.F90
r14757 r14776 140 140 ! 141 141 END DO 142 IF (nn_hls==1) CALL lbc_lnk( 'traadv_ubs', zltu, 'T', 1.0_wp, zltv, 'T', 1.0_wp ) ! Lateral boundary cond. (unchanged sgn)142 IF (nn_hls==1) CALL lbc_lnk( 'traadv_ubs', zltu, 'T', 1.0_wp, zltv, 'T', 1.0_wp, ld4only= .TRUE. ) ! Lateral boundary cond. (unchanged sgn) 143 143 ! 144 144 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) !== Horizontal advective fluxes ==! (UBS)
Note: See TracChangeset
for help on using the changeset viewer.