New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 14797 for NEMO/branches/2021 – NEMO

Changeset 14797 for NEMO/branches/2021


Ignore:
Timestamp:
2021-05-06T12:31:59+02:00 (3 years ago)
Author:
hadcv
Message:

#2600: Merge in dev_r14393_HPC-03_Mele_Comm_Cleanup [14776]

Location:
NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE
Files:
6 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/LBC/lbc_lnk_neicoll_generic.h90

    r14574 r14797  
    2626      INTEGER, DIMENSION(8)  ::   isizej, ishtSj, ishtRj, ishtPj 
    2727      INTEGER, DIMENSION(8)  ::   ifill, iszall 
     28      INTEGER, DIMENSION(8)  ::   jnf 
    2829      INTEGER, DIMENSION(:), ALLOCATABLE  ::   iScnt, iRcnt    ! number of elements to be sent/received 
    2930      INTEGER, DIMENSION(:), ALLOCATABLE  ::   iSdpl, iRdpl    ! displacement in halos arrays 
     
    192193      ! 
    193194      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 
    194210      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)) ) 
    198214         CASE ( jpfillnothing )               ! no filling  
    199215         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)) 
    201217               ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = BUFFRCV(idx) 
    202218               idx = idx + 1 
    203219            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    204220         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)) 
    208224               ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl) 
    209225            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    210226         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)) 
    214230               ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl) 
    215231            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    216232         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)) 
    218234               ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = zland 
    219235            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
  • NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/traadv_cen.F90

    r14780 r14797  
    119119               ztv(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 
    120120            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. 
    122122            ! 
    123123            DO_3D( nn_hls-1, 0, nn_hls-1, 0, 1, jpkm1 )           ! Horizontal advective fluxes 
  • NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/traadv_fct.F90

    r14780 r14797  
    239239            END DO 
    240240            ! 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) 
    242242            ! 
    243243            DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 
     
    262262               ztv(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 
    263263            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) 
    265265            ! 
    266266            DO_3D( 0, 0, 0, 0, 1, jpkm1 )    ! Horizontal advective fluxes 
     
    455455         END_2D 
    456456      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) 
    458458 
    459459      ! 3. monotonic flux in the i & j direction (paa & pbb) 
  • NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/traadv_fct_lf.F90

    r14574 r14797  
    270270               END_2D 
    271271            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 
    273277!            ! 
    274278            DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 
  • NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/traadv_qck.F90

    r14787 r14797  
    149149            zfd(ji,jj,jk) = pt(ji+1,jj,jk,jn,Kbb)        ! Downstream in the x-direction for the tracer 
    150150         END_3D 
    151          IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp )   ! Lateral boundary conditions 
     151         IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, ld4only= .TRUE. )   ! Lateral boundary conditions 
    152152 
    153153         ! 
     
    176176            zfu(ji,jj,jk) = tmask(ji-1,jj,jk) + tmask(ji,jj,jk) + tmask(ji+1,jj,jk) - 2. 
    177177         END_3D 
    178          IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp )      ! Lateral boundary conditions 
     178         IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp, ld4only= .TRUE. )      ! Lateral boundary conditions 
    179179 
    180180         ! 
     
    237237         END_3D 
    238238 
    239          IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp )   ! Lateral boundary conditions 
     239         IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, ld4only= .TRUE. )   ! Lateral boundary conditions 
    240240 
    241241         ! 
     
    266266            zfu(ji,jj,jk) = tmask(ji,jj-1,jk) + tmask(ji,jj,jk) + tmask(ji,jj+1,jk) - 2. 
    267267         END_3D 
    268          IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp )    !--- Lateral boundary conditions 
     268         IF (nn_hls==1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp, ld4only= .TRUE. )    !--- Lateral boundary conditions 
    269269         ! 
    270270         ! Tracer flux on the x-direction 
  • NEMO/branches/2021/dev_r14273_HPC-02_Daley_Tiling/src/OCE/TRA/traadv_ubs.F90

    r14780 r14797  
    140140            ! 
    141141         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) 
    143143         ! 
    144144         DO_3D( 1, 0, 1, 0, 1, jpkm1 )   !==  Horizontal advective fluxes  ==!     (UBS) 
Note: See TracChangeset for help on using the changeset viewer.