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 15127 for NEMO/branches/2021/dev_r14383_PISCES_NEWDEV_PISCO/src/OCE/LBC/lbc_lnk_neicoll_generic.h90 – NEMO

Ignore:
Timestamp:
2021-07-16T20:00:12+02:00 (3 years ago)
Author:
cetlod
Message:

dev_PISCO : merge with trunk@15119

Location:
NEMO/branches/2021/dev_r14383_PISCES_NEWDEV_PISCO
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2021/dev_r14383_PISCES_NEWDEV_PISCO

    • Property svn:externals

      •  

        old new  
        99 
        1010# SETTE 
        11 ^/utils/CI/sette@14244        sette 
         11^/utils/CI/sette@HEAD        sette 
         12 

  • NEMO/branches/2021/dev_r14383_PISCES_NEWDEV_PISCO/src/OCE/LBC/lbc_lnk_neicoll_generic.h90

    r14448 r15127  
    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 
    … …  
    3132      REAL(PRECISION) ::   zland 
    3233      LOGICAL  ::   ll4only                                    ! default: 8 neighbourgs 
    33       LOGICAL  ::   ll_IdoNFold 
    3434      !!---------------------------------------------------------------------- 
    3535      ! 
    … …  
    101101      END DO 
    102102      ! north fold treatment 
    103       ll_IdoNFold = l_IdoNFold .AND. ifill(jpno) /= jpfillnothing 
    104       IF( ll_IdoNFold ) THEN 
     103      IF( l_IdoNFold ) THEN 
    105104         ifill_nfd = ifill(jpno)             ! if we are here, this means llrecv(jpno) = .false. and l_SelfPerio(jpno) = .false. 
    106105         ifill( (/jpno/) ) = jpfillnothing   ! we do north fold -> do nothing for northern halo 
    … …  
    192191      ! 
    193192      idx = 1 
     193      ! MPI3 bug fix when domain decomposition has 2 columns/rows 
     194      IF (jpni .eq. 2) THEN 
     195         IF (jpnj .eq. 2) THEN 
     196            jnf(1:8) = (/ 2, 1, 4, 3, 8, 7, 6, 5 /) 
     197         ELSE 
     198            jnf(1:8) = (/ 2, 1, 3, 4, 6, 5, 8, 7 /) 
     199         ENDIF 
     200      ELSE 
     201         IF (jpnj .eq. 2) THEN 
     202            jnf(1:8) = (/ 1, 2, 4, 3, 7, 8, 5, 6 /) 
     203         ELSE 
     204            jnf(1:8) = (/ 1, 2, 3, 4, 5, 6, 7, 8 /) 
     205         ENDIF 
     206      ENDIF 
     207 
    194208      DO jn = 1, 8 
    195          ishti = ishtRi(jn) 
    196          ishtj = ishtRj(jn) 
    197          SELECT CASE ( ifill(jn) ) 
     209         ishti = ishtRi(jnf(jn)) 
     210         ishtj = ishtRj(jnf(jn)) 
     211         SELECT CASE ( ifill(jnf(jn)) ) 
    198212         CASE ( jpfillnothing )               ! no filling  
    199213         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) 
     214            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jnf(jn))  ;  DO ji = 1,isizei(jnf(jn)) 
    201215               ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = BUFFRCV(idx) 
    202216               idx = idx + 1 
    203217            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    204218         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) 
     219            ishti2 = ishtPi(jnf(jn)) 
     220            ishtj2 = ishtPj(jnf(jn)) 
     221            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jnf(jn))  ;  DO ji = 1,isizei(jnf(jn)) 
    208222               ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl) 
    209223            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    210224         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) 
     225            ishti2 = ishtSi(jnf(jn)) 
     226            ishtj2 = ishtSj(jnf(jn)) 
     227            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jnf(jn))  ;  DO ji = 1,isizei(jnf(jn)) 
    214228               ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = ptab(jf)%pt4d(ishti2+ji,ishtj2+jj,jk,jl) 
    215229            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    216230         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) 
     231            DO jf = 1, ipf  ;  DO jl = 1, ipl  ;  DO jk = 1, ipk  ;  DO jj = 1,isizej(jnf(jn))  ;  DO ji = 1,isizei(jnf(jn)) 
    218232               ptab(jf)%pt4d(ishti+ji,ishtj+jj,jk,jl) = zland 
    219233            END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    … …  
    251265      ! ------------------------------- ! 
    252266      ! 
    253       IF( ll_IdoNFold ) THEN 
     267      IF( l_IdoNFold ) THEN 
    254268         IF( jpni == 1 )  THEN   ;   CALL lbc_nfd( ptab, cd_nat, psgn                  , ihls, ipf )   ! self NFold 
    255269         ELSE                    ;   CALL mpp_nfd( ptab, cd_nat, psgn, ifill_nfd, zland, ihls, ipf )   ! mpi  NFold 
Note: See TracChangeset for help on using the changeset viewer.