Changeset 12586


Ignore:
Timestamp:
2020-03-23T13:14:40+01:00 (3 weeks ago)
Author:
francesca
Message:

Add extra-halo support (jperio 3,4) - ticket #2366

Location:
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src
Files:
1 added
21 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/DOM/dom_oce.F90

    r12489 r12586  
    114114   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:) ::   e1f   , e2f  , r1_e1f, r1_e2f   !: horizontal scale factors at f-point [m] 
    115115   ! 
    116    REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2t , r1_e1e2t                !: associated metrics at t-point 
    117    REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2u , r1_e1e2u , e2_e1u       !: associated metrics at u-point 
    118    REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2v , r1_e1e2v , e1_e2v       !: associated metrics at v-point 
     116   REAL(wp), PUBLIC, POINTER, SAVE            , DIMENSION(:,:) ::   r1_e1e2t, r1_e1e2u, r1_e1e2v    !: associated metrics at t-point 
     117   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2t                 !: associated metrics at t-point 
     118   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2u , e2_e1u       !: associated metrics at u-point 
     119   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2v , e1_e2v       !: associated metrics at v-point 
    119120   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2f , r1_e1e2f                !: associated metrics at f-point 
    120121   ! 
     
    136137   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::    e3vw_0   !: vw-vert. scale factor [m] 
    137138   !                                                        !  time-dependent scale factors 
    138    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e3t, e3u, e3v, e3w, e3uw, e3vw  !: vert. scale factor [m] 
     139   REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:,:) ::   e3t, e3u, e3v, e3w  !: vert. scale factor [m] 
     140   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e3uw, e3vw  !: vert. scale factor [m] 
    139141   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   e3f                             !: F-point vert. scale factor [m] 
    140142 
     
    176178   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   tmask_h            !: internal domain T-point mask (Figure 8.5 NEMO book) 
    177179 
    178    INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   mikt, miku, mikv, mikf  !: top first wet T-, U-, V-, F-level           (ISF) 
     180   INTEGER , PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   miku, mikv, mikf   !: top first wet U-, V-, F-level           (ISF) 
     181   REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:) ::   mikt                   !: top first wet T-level (ISF) 
    179182 
    180183   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ssmask, ssumask, ssvmask             !: surface mask at T-,U-, V- and F-pts 
    181    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: tmask, umask, vmask, fmask   !: land/ocean mask at T-, U-, V- and F-pts 
    182    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: wmask, wumask, wvmask        !: land/ocean mask at WT-, WU- and WV-pts 
     184   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: fmask   !: land/ocean mask at F-pts 
     185   REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:) :: tmask, umask, vmask, wmask  !: land/ocean mask at T-, U-, V-pts 
     186   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET :: wumask, wvmask        !: land/ocean mask at WT-, WU- and WV-pts 
    183187 
    184188   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   tpol, fpol          !: north fold mask (jperio= 3 or 4) 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/lbc_lnk_multi_generic.h90

    r11536 r12586  
    1919      &                    , pt5, cdna5, psgn5, pt6 , cdna6 , psgn6 , pt7 , cdna7 , psgn7 , pt8, cdna8, psgn8   & 
    2020      &                    , pt9, cdna9, psgn9, pt10, cdna10, psgn10, pt11, cdna11, psgn11                      & 
    21       &                    , kfillmode, pfillval, lsend, lrecv, ihlcom ) 
     21      &                    , kfillmode, pfillval, lsend, lrecv ) 
    2222      !!--------------------------------------------------------------------- 
    2323      CHARACTER(len=*)   ,                   INTENT(in   ) :: cdname  ! name of the calling subroutine 
     
    3131      REAL(wp)           , OPTIONAL        , INTENT(in   ) :: pfillval    ! background value (used at closed boundaries) 
    3232      LOGICAL, DIMENSION(4), OPTIONAL      , INTENT(in   ) :: lsend, lrecv   ! indicate how communications are to be carried out 
    33       INTEGER            , OPTIONAL        , INTENT(in   ) :: ihlcom         ! number of ranks and rows to be communicated 
    3433      !! 
    3534      INTEGER                          ::   kfld        ! number of elements that will be attributed 
     
    5655      IF( PRESENT(psgn11) )   CALL ROUTINE_LOAD( pt11, cdna11, psgn11, ptab_ptr, cdna_ptr, psgn_ptr, kfld ) 
    5756      ! 
    58       CALL lbc_lnk_ptr    ( cdname,               ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv, ihlcom ) 
     57      CALL lbc_lnk_ptr    ( cdname,               ptab_ptr, cdna_ptr, psgn_ptr, kfld, kfillmode, pfillval, lsend, lrecv ) 
    5958      ! 
    6059   END SUBROUTINE ROUTINE_MULTI 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/lbc_nfd_nogather_generic.h90

    r11536 r12586  
    4444#      define L_SIZE(ptab)          SIZE(ptab,4) 
    4545#   endif 
    46 #   define ARRAY2_IN(i,j,k,l,f)  ptab2(i,j,k,l) 
    4746#   define J_SIZE(ptab2)             SIZE(ptab2,2) 
     47#   define ARRAY2_IN(i,j,k,l,f)   ptab2(i,j,k,l) 
    4848#   define ARRAY_TYPE(i,j,k,l,f)     REAL(wp),INTENT(inout)::ARRAY_IN(i,j,k,l,f) 
    4949#   define ARRAY2_TYPE(i,j,k,l,f)    REAL(wp),INTENT(inout)::ARRAY2_IN(i,j,k,l,f) 
     
    5757      !! 
    5858      !!---------------------------------------------------------------------- 
    59       ARRAY_TYPE(:,:,:,:,:)                             ! array or pointer of arrays on which the boundary condition is applied 
    60       ARRAY2_TYPE(:,:,:,:,:)                            ! array or pointer of arrays on which the boundary condition is applied 
     59      ARRAY_TYPE(1-nn_hls+1:,1-nn_hls+1:,:,:,:) 
     60      ARRAY2_TYPE(1-nn_hls+1:,:,:,:,:)  
    6161      CHARACTER(len=1) , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points 
    6262      REAL(wp)         , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary 
    6363      INTEGER, OPTIONAL, INTENT(in   ) ::   kfld        ! number of pt3d arrays 
    6464      ! 
    65       INTEGER  ::    ji,  jj,   jk,     jl,   jh,  jf   ! dummy loop indices 
    66       INTEGER  ::   ipi, ipj,  ipk,    ipl,  ipf        ! dimension of the input array 
    67       INTEGER  ::   ijt, iju, ijpj, ijpjp1, ijta, ijua, jia, startloop, endloop 
     65      INTEGER  ::    ji,  jj,   jk, jn, ii,   jl,   jh,  jf   ! dummy loop indices 
     66      INTEGER  ::   ipi, ipj,  ipk,    ipl,  ipf, ijj   ! dimension of the input array 
     67      INTEGER  ::   ijt, iju, ijta, ijua, jia, startloop, endloop 
    6868      LOGICAL  ::   l_fast_exchanges 
    6969      !!---------------------------------------------------------------------- 
     
    7575      ! Security check for further developments 
    7676      IF ( ipf > 1 ) CALL ctl_stop( 'STOP', 'lbc_nfd_nogather: multiple fields not allowed. Revise implementation...' ) 
    77       ! 
    78       ijpj   = 1    ! index of first modified line  
    79       ijpjp1 = 2    ! index + 1 
    80        
    8177      ! 2nd dimension determines exchange speed 
    8278      IF (ipj == 1 ) THEN 
     
    9591            ! 
    9692            CASE ( 'T' , 'W' )                         ! T-, W-point 
    97                IF ( nimpp /= 1 ) THEN   ;   startloop = 1 
     93               IF ( nimpp - nn_hls+1 /= 1 ) THEN  ;  startloop = 1 - nn_hls + 1 
    9894               ELSE                     ;   startloop = 2 
    9995               ENDIF 
    10096               ! 
    10197               DO jl = 1, ipl; DO jk = 1, ipk 
    102                   DO ji = startloop, nlci 
    103                      ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    104                      ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj,jk,jl,jf) 
    105                   END DO 
    106                END DO; END DO 
    107                IF( nimpp == 1 ) THEN 
    108                   DO jl = 1, ipl; DO jk = 1, ipk 
    109                      ARRAY_IN(1,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(3,nlcj-2,jk,jl,jf) 
    110                   END DO; END DO 
    111                ENDIF 
    112                ! 
    113                IF ( .NOT. l_fast_exchanges ) THEN 
    114                   IF( nimpp >= jpiglo/2+1 ) THEN 
    115                      startloop = 1 
    116                   ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN 
    117                      startloop = jpiglo/2+1 - nimpp + 1 
     98                    DO jj = 1, nn_hls 
     99                     ijj = nlcj -jj +1 
     100                     DO ji = startloop, nlci 
     101                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
     102                        ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf) 
     103                    END DO 
     104                  END DO 
     105               END DO; END DO 
     106               IF( nimpp - nn_hls+1 == 1 ) THEN 
     107                  DO jl = 1, ipl; DO jk = 1, ipk 
     108                     DO jj = 1, nn_hls 
     109                        ijj = nlcj -jj +1 
     110                        DO ii = 1, nn_hls 
     111                           ARRAY_IN(1-ii+1,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii+2,nlcj-2*nn_hls+jj-1,jk,jl,jf) 
     112                        END DO 
     113                     END DO 
     114                  END DO; END DO 
     115               ENDIF               
     116               ! 
     117               IF ( .NOT. l_fast_exchanges ) THEN 
     118                  IF( nimpp - nn_hls +1 >= jpiglo/2+1 ) THEN 
     119                     startloop = 1 - nn_hls +1 
     120                ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp - nn_hls +1 < jpiglo/2+1 ) THEN 
     121                     startloop = jpiglo/2+1 - nimpp + nn_hls 
    118122                  ELSE 
    119123                     startloop = nlci + 1 
     
    126130                           ijta = jpiglo - jia + 2 
    127131                           IF( ijta >= startloop+nimpp-1 .AND. ijta < jia ) THEN 
    128                               ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijta-nimpp+1,nlcj-1,jk,jl,jf) 
     132                              ARRAY_IN(ji,nlcj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijta-nimpp+1,nlcj-nn_hls,jk,jl,jf) 
    129133                           ELSE 
    130                               ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpjp1,jk,jl,jf) 
     134                              ARRAY_IN(ji,nlcj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,nn_hls+1,jk,jl,jf) 
    131135                           ENDIF 
    132136                        END DO 
     
    134138                  ENDIF 
    135139               ENDIF 
    136  
     140            CASE ( 'U' )                                     ! U-point 
     141               IF( nimpp + nlci - nn_hls /= jpiglo ) THEN 
     142                  endloop = nlci 
     143               ELSE 
     144                  endloop = nlci - nn_hls 
     145               ENDIF 
     146               DO jl = 1, ipl; DO jk = 1, ipk 
     147              DO jj = 1, nn_hls 
     148                     ijj = nlcj -jj +1 
     149                     DO ji = 1-nn_hls+1, endloop 
     150                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
     151                        ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,jj,jk,jl,jf) 
     152                     END DO 
     153                  END DO 
     154               END DO; END DO 
     155               IF (nimpp - nn_hls+1 .eq. 1) THEN 
     156               DO jj = 1, nn_hls 
     157                  ijj = nlcj -jj +1 
     158                  DO ii = 1, nn_hls 
     159                     ARRAY_IN(2-ii,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ii+1,nlcj-2*nn_hls+jj-1,:,:,jf) 
     160                  END DO 
     161                     END DO 
     162               ENDIF 
     163               IF((nimpp + nlci - nn_hls) .eq. jpiglo) THEN 
     164                     DO jj = 1, nn_hls 
     165                        ijj = nlcj -jj +1 
     166                  DO ii = 1, nn_hls 
     167                     ARRAY_IN(nlci-ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-2*nn_hls+ii,nlcj-2*nn_hls+jj-1,:,:,jf) 
     168                  END DO 
     169               END DO 
     170               ENDIF 
     171               ! 
     172               IF ( .NOT. l_fast_exchanges ) THEN 
     173                  IF( nimpp + nlci - nn_hls /= jpiglo ) THEN 
     174                     endloop = nlci 
     175                  ELSE 
     176                     endloop = nlci - nn_hls 
     177                  ENDIF 
     178                  IF( nimpp - nn_hls+1 >= jpiglo/2 ) THEN 
     179                     startloop = 1- nn_hls + 1 
     180                     ELSEIF( ( nimpp+nlci-1 >= jpiglo/2 ) .AND. ( nimpp - nn_hls+1 < jpiglo/2 ) ) THEN 
     181                     startloop = jpiglo/2 - nimpp + nn_hls 
     182                  ELSE 
     183                     startloop = endloop + 1 
     184                  ENDIF 
     185                  IF( startloop <= endloop ) THEN 
     186                  DO jl = 1, ipl; DO jk = 1, ipk 
     187                     DO ji = startloop, endloop 
     188                        iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
     189                        jia = ji + nimpp - 1 
     190                        ijua = jpiglo - jia + 1 
     191                        IF( ijua >= startloop+nimpp-1 .AND. ijua < jia ) THEN 
     192                           ARRAY_IN(ji,nlcj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijua-nimpp+1,nlcj-nn_hls,jk,jl,jf) 
     193                        ELSE 
     194                           ARRAY_IN(ji,nlcj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,nn_hls+1,jk,jl,jf) 
     195                        ENDIF 
     196                     END DO 
     197                  END DO; END DO 
     198                  ENDIF 
     199               ENDIF 
     200               ! 
     201            CASE ( 'V' )                                     ! V-point 
     202               IF( nimpp - nn_hls+1 /= 1 ) THEN 
     203                 startloop = 1 - nn_hls + 1 
     204               ELSE 
     205                 startloop = 2 
     206               ENDIF 
     207               IF ( .NOT. l_fast_exchanges ) THEN 
     208                  DO jl = 1, ipl; DO jk = 1, ipk 
     209                     DO jj = 2, nn_hls+1 
     210                        ijj = nlcj -jj +1 
     211                        DO ji = startloop, nlci 
     212                           ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
     213                           ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf) 
     214                        END DO 
     215                    END DO 
     216                  END DO; END DO 
     217               ENDIF 
     218               DO jl = 1, ipl; DO jk = 1, ipk 
     219                  DO ji = startloop, nlci 
     220                     ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
     221                     ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,1,jk,jl,jf) 
     222                  END DO 
     223               END DO; END DO 
     224               IF (nimpp - nn_hls+1.eq. 1) THEN 
     225               DO jj = 1, nn_hls 
     226                        ijj = nlcj-jj+1 
     227                        DO ii = 1, nn_hls 
     228                        ARRAY_IN(1-ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ii+2,nlcj-2*nn_hls+jj-1,:,:,jf) 
     229                  END DO 
     230               END DO 
     231               ENDIF 
     232            CASE ( 'F' )                                     ! F-point 
     233               IF( nimpp + nlci - nn_hls /= jpiglo ) THEN 
     234                  endloop = nlci 
     235               ELSE 
     236                  endloop = nlci - nn_hls 
     237               ENDIF 
     238               IF ( .NOT. l_fast_exchanges ) THEN 
     239                  DO jl = 1, ipl; DO jk = 1, ipk 
     240                     DO jj = 2, nn_hls+1 
     241                        ijj = nlcj -jj +1 
     242                        DO ji = 1 - nn_hls +1, endloop 
     243                           iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
     244                           ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,jj,jk,jl,jf) 
     245                        END DO 
     246                    END DO 
     247                  END DO; END DO 
     248               ENDIF 
     249               DO jl = 1, ipl; DO jk = 1, ipk 
     250                  DO ji = 1- nn_hls +1, endloop 
     251                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
     252                     ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,1,jk,jl,jf) 
     253                  END DO 
     254               END DO; END DO 
     255      IF (nimpp - nn_hls+1.eq. 1) THEN                
     256         DO ii = 1, nn_hls 
     257                     ARRAY_IN(2-ii,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ii+1,nlcj-2*nn_hls-1,:,:,jf) 
     258         END DO 
     259         IF ( .NOT. l_fast_exchanges ) THEN 
     260            DO jj = 1, nn_hls 
     261                           ijj = nlcj -jj 
     262                           DO ii = 1, nn_hls 
     263                           ARRAY_IN(2-ii,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ii+1,nlcj-2*nn_hls+jj-1,:,:,jf) 
     264                              END DO 
     265                        END DO 
     266                     ENDIF 
     267      ENDIF 
     268      IF((nimpp + nlci - nn_hls ) .eq. jpiglo) THEN 
     269                     DO ii = 1, nn_hls 
     270                     ARRAY_IN(nlci-ii+1,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-2*nn_hls+ii,nlcj-2*nn_hls-1,:,:,jf) 
     271         END DO 
     272         IF ( .NOT. l_fast_exchanges ) THEN 
     273            DO jj = 1, nn_hls 
     274                           ijj = nlcj -jj 
     275                           DO ii = 1, nn_hls 
     276                           ARRAY_IN(nlci-ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-2*nn_hls+ii,nlcj-2*nn_hls+jj-1,:,:,jf) 
     277                           END DO 
     278                        END DO 
     279                     ENDIF 
     280                  ENDIF 
     281                  ! 
     282       END SELECT 
     283            ! 
     284         CASE ( 5, 6 )                        ! *  North fold  F-point pivot 
     285            ! 
     286            WRITE(*,*) 'extrahalo not handled in this case', __FILE__, __LINE__ 
     287            SELECT CASE ( NAT_IN(jf) ) 
     288            CASE ( 'T' , 'W' )                               ! T-, W-point 
     289               DO jl = 1, ipl; DO jk = 1, ipk 
     290              DO jj = 1, nn_hls 
     291                      ijj = nlcj -jj+1 
     292                  DO ji = 1, nlci 
     293                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
     294                     ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf) 
     295                  END DO 
     296              END DO 
     297               END DO; END DO 
     298               ! 
    137299            CASE ( 'U' )                                     ! U-point 
    138300               IF( nimpp + nlci - 1 /= jpiglo ) THEN 
     
    143305               DO jl = 1, ipl; DO jk = 1, ipk 
    144306                  DO ji = 1, endloop 
    145                      iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    146                      ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj,jk,jl,jf) 
    147                   END DO 
    148                END DO; END DO 
    149                IF (nimpp .eq. 1) THEN 
    150                   ARRAY_IN(1,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2,nlcj-2,:,:,jf) 
    151                ENDIF 
     307                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
     308                     ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj-1,jk,jl,jf) 
     309                  END DO 
     310               END DO; END DO 
    152311               IF((nimpp + nlci - 1) .eq. jpiglo) THEN 
    153                   ARRAY_IN(nlci,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-1,nlcj-2,:,:,jf) 
    154                ENDIF 
    155                ! 
    156                IF ( .NOT. l_fast_exchanges ) THEN 
    157                   IF( nimpp + nlci - 1 /= jpiglo ) THEN 
    158                      endloop = nlci 
    159                   ELSE 
    160                      endloop = nlci - 1 
    161                   ENDIF 
    162                   IF( nimpp >= jpiglo/2 ) THEN 
    163                      startloop = 1 
    164                      ELSEIF( ( nimpp+nlci-1 >= jpiglo/2 ) .AND. ( nimpp < jpiglo/2 ) ) THEN 
    165                      startloop = jpiglo/2 - nimpp + 1 
    166                   ELSE 
    167                      startloop = endloop + 1 
    168                   ENDIF 
    169                   IF( startloop <= endloop ) THEN 
    170                   DO jl = 1, ipl; DO jk = 1, ipk 
    171                      DO ji = startloop, endloop 
    172                         iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    173                         jia = ji + nimpp - 1 
    174                         ijua = jpiglo - jia + 1 
    175                         IF( ijua >= startloop+nimpp-1 .AND. ijua < jia ) THEN 
    176                            ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijua-nimpp+1,nlcj-1,jk,jl,jf) 
    177                         ELSE 
    178                            ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpjp1,jk,jl,jf) 
    179                         ENDIF 
    180                      END DO 
    181                   END DO; END DO 
    182                   ENDIF 
     312                  DO jl = 1, ipl; DO jk = 1, ipk 
     313                     ARRAY_IN(nlci,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(nlci-2,nlcj-1,jk,jl,jf) 
     314                  END DO; END DO 
    183315               ENDIF 
    184316               ! 
    185317            CASE ( 'V' )                                     ! V-point 
    186                IF( nimpp /= 1 ) THEN 
    187                  startloop = 1 
    188                ELSE 
    189                  startloop = 2 
    190                ENDIF 
    191                IF ( .NOT. l_fast_exchanges ) THEN 
    192                   DO jl = 1, ipl; DO jk = 1, ipk 
    193                      DO ji = startloop, nlci 
    194                         ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    195                         ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpjp1,jk,jl,jf) 
    196                      END DO 
    197                   END DO; END DO 
    198                ENDIF 
    199                DO jl = 1, ipl; DO jk = 1, ipk 
    200                   DO ji = startloop, nlci 
    201                      ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    202                      ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj,jk,jl,jf) 
    203                   END DO 
    204                END DO; END DO 
    205                IF (nimpp .eq. 1) THEN 
    206                   ARRAY_IN(1,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(3,nlcj-3,:,:,jf) 
    207                ENDIF 
    208             CASE ( 'F' )                                     ! F-point 
    209                IF( nimpp + nlci - 1 /= jpiglo ) THEN 
    210                   endloop = nlci 
    211                ELSE 
    212                   endloop = nlci - 1 
    213                ENDIF 
    214                IF ( .NOT. l_fast_exchanges ) THEN 
    215                   DO jl = 1, ipl; DO jk = 1, ipk 
    216                      DO ji = 1, endloop 
    217                         iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    218                         ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpjp1,jk,jl,jf) 
    219                      END DO 
    220                   END DO; END DO 
    221                ENDIF 
    222                DO jl = 1, ipl; DO jk = 1, ipk 
    223                   DO ji = 1, endloop 
    224                      iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    225                      ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj,jk,jl,jf) 
    226                   END DO 
    227                END DO; END DO 
    228                IF (nimpp .eq. 1) THEN 
    229                   ARRAY_IN(1,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2,nlcj-3,:,:,jf) 
    230                   IF ( .NOT. l_fast_exchanges ) & 
    231                      ARRAY_IN(1,nlcj-1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2,nlcj-2,:,:,jf) 
    232                ENDIF 
    233                IF((nimpp + nlci - 1) .eq. jpiglo) THEN 
    234                   ARRAY_IN(nlci,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-1,nlcj-3,:,:,jf) 
    235                   IF ( .NOT. l_fast_exchanges ) & 
    236                      ARRAY_IN(nlci,nlcj-1,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-1,nlcj-2,:,:,jf) 
    237                ENDIF 
    238                ! 
    239             END SELECT 
    240             ! 
    241          CASE ( 5, 6 )                        ! *  North fold  F-point pivot 
    242             ! 
    243             SELECT CASE ( NAT_IN(jf) ) 
    244             CASE ( 'T' , 'W' )                               ! T-, W-point 
    245318               DO jl = 1, ipl; DO jk = 1, ipk 
    246319                  DO ji = 1, nlci 
    247320                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    248                      ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj,jk,jl,jf) 
    249                   END DO 
    250                END DO; END DO 
    251                ! 
    252             CASE ( 'U' )                                     ! U-point 
    253                IF( nimpp + nlci - 1 /= jpiglo ) THEN 
    254                   endloop = nlci 
    255                ELSE 
    256                   endloop = nlci - 1 
    257                ENDIF 
    258                DO jl = 1, ipl; DO jk = 1, ipk 
    259                   DO ji = 1, endloop 
    260                      iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
    261                      ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj,jk,jl,jf) 
    262                   END DO 
    263                END DO; END DO 
    264                IF((nimpp + nlci - 1) .eq. jpiglo) THEN 
    265                   DO jl = 1, ipl; DO jk = 1, ipk 
    266                      ARRAY_IN(nlci,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(nlci-2,nlcj-1,jk,jl,jf) 
    267                   END DO; END DO 
    268                ENDIF 
    269                ! 
    270             CASE ( 'V' )                                     ! V-point 
    271                DO jl = 1, ipl; DO jk = 1, ipk 
    272                   DO ji = 1, nlci 
    273                      ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    274                      ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj,jk,jl,jf) 
     321                     ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj-1,jk,jl,jf) 
    275322                  END DO 
    276323               END DO; END DO 
     
    288335                     DO ji = startloop, nlci 
    289336                        ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    290                         ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpjp1,jk,jl,jf) 
     337                        ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,ijpj,jk,jl,jf) 
    291338                     END DO 
    292339                  END DO; END DO 
     
    303350                  DO ji = 1, endloop 
    304351                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
    305                      ARRAY_IN(ji,nlcj ,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj,jk,jl,jf) 
     352                     ARRAY_IN(ji,nlcj ,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj-1,jk,jl,jf) 
    306353                  END DO 
    307354               END DO; END DO 
     
    329376                        DO ji = startloop, endloop 
    330377                           iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
    331                            ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpjp1,jk,jl,jf) 
     378                           ARRAY_IN(ji,nlcj-1,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,ijpj,jk,jl,jf) 
    332379                        END DO 
    333380                     END DO; END DO 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/lbcnfd.F90

    r11536 r12586  
    5353 
    5454   INTEGER, PUBLIC, PARAMETER            ::   jpmaxngh = 3               !: 
    55    INTEGER, PUBLIC                       ::   nsndto, nfsloop, nfeloop   !: 
     55   INTEGER, PUBLIC                       ::   nsndto                     !: 
    5656   INTEGER, PUBLIC, DIMENSION (jpmaxngh) ::   isendto                    !: processes to which communicate 
     57   INTEGER, PUBLIC                       ::   ijpj 
    5758 
    5859   !!---------------------------------------------------------------------- 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/mpp_lnk_generic.h90

    r11536 r12586  
    4646 
    4747#if defined MULTI 
    48    SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, lsend, lrecv, ihlcom ) 
     48   SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, lsend, lrecv ) 
    4949      INTEGER             , INTENT(in   ) ::   kfld        ! number of pt3d arrays 
    5050#else 
    51    SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn      , kfillmode, pfillval, lsend, lrecv, ihlcom ) 
     51   SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn      , kfillmode, pfillval, lsend, lrecv ) 
    5252#endif 
    53       ARRAY_TYPE(:,:,:,:,:)                                        ! array or pointer of arrays on which the boundary condition is applied 
     53      ARRAY_TYPE(1-nn_hls+1:,1-nn_hls+1:,:,:,:)                                        ! array or pointer of arrays on which the boundary condition is applied 
    5454      CHARACTER(len=*)              , INTENT(in   ) ::   cdname      ! name of the calling subroutine 
    5555      CHARACTER(len=1)              , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points 
     
    5858      REAL(wp),             OPTIONAL, INTENT(in   ) ::   pfillval    ! background value (used at closed boundaries) 
    5959      LOGICAL, DIMENSION(4),OPTIONAL, INTENT(in   ) ::   lsend, lrecv  ! communication with other 4 proc 
    60       INTEGER              ,OPTIONAL, INTENT(in   ) ::   ihlcom        ! number of ranks and rows to be communicated 
    6160      ! 
    6261      INTEGER  ::    ji,  jj,  jk,  jl,  jf      ! dummy loop indices 
     
    6665      INTEGER  ::   ierr 
    6766      INTEGER  ::   ifill_we, ifill_ea, ifill_so, ifill_no 
    68       INTEGER  ::   ihl                          ! number of ranks and rows to be communicated  
    6967      REAL(wp) ::   zland 
    7068      INTEGER , DIMENSION(MPI_STATUS_SIZE)        ::   istat          ! for mpi_isend 
     
    8381      ipl = L_SIZE(ptab)   ! 4th    - 
    8482      ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers) 
    85       ! 
    86       IF( PRESENT(ihlcom) ) THEN   ;   ihl = ihlcom 
    87       ELSE                         ;   ihl = 1 
    88       END IF 
    8983      ! 
    9084      IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ipk, ipl, ipf, ld_lbc = .TRUE. ) 
     
    148142      ! -------------------------------------------------- ! 
    149143      ! 
     144 
    150145      ! Must exchange the whole column (from 1 to jpj) to get the corners if we have no south/north neighbourg 
    151       isize = ihl * jpj * ipk * ipl * ipf       
     146      isize = nn_hls * ( jpj + nn_hls - 1 ) * ipk * ipl * ipf       
    152147      ! 
    153148      ! Allocate local temporary arrays to be sent/received. Fill arrays to be sent 
    154       IF( llsend_we )   ALLOCATE( zsnd_we(ihl,jpj,ipk,ipl,ipf) ) 
    155       IF( llsend_ea )   ALLOCATE( zsnd_ea(ihl,jpj,ipk,ipl,ipf) ) 
    156       IF( llrecv_we )   ALLOCATE( zrcv_we(ihl,jpj,ipk,ipl,ipf) ) 
    157       IF( llrecv_ea )   ALLOCATE( zrcv_ea(ihl,jpj,ipk,ipl,ipf) ) 
     149      IF( llsend_we )   ALLOCATE( zsnd_we(nn_hls,1-nn_hls+1:jpj,ipk,ipl,ipf) ) 
     150      IF( llsend_ea )   ALLOCATE( zsnd_ea(nn_hls,1-nn_hls+1:jpj,ipk,ipl,ipf) ) 
     151      IF( llrecv_we )   ALLOCATE( zrcv_we(nn_hls,1-nn_hls+1:jpj,ipk,ipl,ipf) ) 
     152      IF( llrecv_ea )   ALLOCATE( zrcv_ea(nn_hls,1-nn_hls+1:jpj,ipk,ipl,ipf) ) 
    158153      ! 
    159154      IF( llsend_we ) THEN   ! copy western side of the inner mpi domain in local temporary array to be sent by MPI 
    160          ishift = ihl 
    161          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, ihl 
    162             zsnd_we(ji,jj,jk,jl,jf) = ARRAY_IN(ishift+ji,jj,jk,jl,jf)   ! ihl + 1 -> 2*ihl 
    163          END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    164       ENDIF 
    165       ! 
    166       IF(llsend_ea ) THEN   ! copy eastern side of the inner mpi domain in local temporary array to be sent by MPI 
    167          ishift = jpi - 2 * ihl 
    168          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, ihl 
    169             zsnd_ea(ji,jj,jk,jl,jf) = ARRAY_IN(ishift+ji,jj,jk,jl,jf)   ! jpi - 2*ihl + 1 -> jpi - ihl 
     155         ishift = 1 
     156         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1-nn_hls+1, jpj   ;   DO ji = 1, nn_hls 
     157            zsnd_we(ji,jj,jk,jl,jf) = ARRAY_IN(ishift+ji,jj,jk,jl,jf)   ! nn_hls + 1 -> 2*nn_hls 
     158         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
     159      ENDIF 
     160      ! 
     161      IF( llsend_ea ) THEN   ! copy eastern side of the inner mpi domain in local temporary array to be sent by MPI 
     162         ishift = jpi -  2 * nn_hls 
     163         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1-nn_hls+1, jpj   ;   DO ji = 1, nn_hls 
     164            zsnd_ea(ji,jj,jk,jl,jf) = ARRAY_IN(ishift+ji,jj,jk,jl,jf)   ! jpi - 2*nn_hls + 1 -> jpi - nn_hls 
    170165         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    171166      ENDIF 
     
    174169      ! 
    175170      ! non-blocking send of the western/eastern side using local temporary arrays 
    176       IF( llsend_we )   CALL mppsend( 1, zsnd_we(1,1,1,1,1), isize, nowe, ireq_we ) 
    177       IF( llsend_ea )   CALL mppsend( 2, zsnd_ea(1,1,1,1,1), isize, noea, ireq_ea ) 
     171      IF( llsend_we )   CALL mppsend( 1, zsnd_we(1,1-nn_hls+1,1,1,1), isize, nowe, ireq_we ) 
     172      IF( llsend_ea )   CALL mppsend( 2, zsnd_ea(1,1-nn_hls+1,1,1,1), isize, noea, ireq_ea ) 
    178173      ! blocking receive of the western/eastern halo in local temporary arrays 
    179       IF( llrecv_we )   CALL mpprecv( 2, zrcv_we(1,1,1,1,1), isize, nowe ) 
    180       IF( llrecv_ea )   CALL mpprecv( 1, zrcv_ea(1,1,1,1,1), isize, noea ) 
     174      IF( llrecv_we )   CALL mpprecv( 2, zrcv_we(1,1-nn_hls+1,1,1,1), isize, nowe ) 
     175      IF( llrecv_ea )   CALL mpprecv( 1, zrcv_ea(1,1-nn_hls+1,1,1,1), isize, noea ) 
    181176      ! 
    182177      IF( ln_timing ) CALL tic_tac(.FALSE.) 
     
    189184      ! 2.1 fill weastern halo 
    190185      ! ---------------------- 
    191       ! ishift = 0                         ! fill halo from ji = 1 to ihl 
     186      ! ishift = 0                         ! fill halo from ji = 1 to nn_hls 
    192187      SELECT CASE ( ifill_we ) 
    193188      CASE ( jpfillnothing )               ! no filling  
    194189      CASE ( jpfillmpi   )                 ! use data received by MPI  
    195          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, ihl 
    196             ARRAY_IN(ji,jj,jk,jl,jf) = zrcv_we(ji,jj,jk,jl,jf)   ! 1 -> ihl 
     190         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1-nn_hls+1, jpj   ;   DO ji = 1, nn_hls 
     191            ARRAY_IN(ji-nn_hls+1,jj,jk,jl,jf) = zrcv_we(ji,jj,jk,jl,jf)   ! 1 -> nn_hls 
    197192         END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
    198193      CASE ( jpfillperio )                 ! use east-weast periodicity 
    199          ishift2 = jpi - 2 * ihl 
    200          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, ihl 
    201             ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf) 
     194         ishift2 = jpi - 2 * nn_hls 
     195         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1-nn_hls+1, jpj   ;   DO ji = 1, nn_hls 
     196            ARRAY_IN(ji-nn_hls+1,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf) 
    202197         END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
    203198      CASE ( jpfillcopy  )                 ! filling with inner domain values 
    204199         DO jf = 1, ipf                               ! number of arrays to be treated 
    205200            IF( .NOT. NAT_IN(jf) == 'F' ) THEN        ! do nothing for F point 
    206                DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, ihl 
    207                   ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ihl+1,jj,jk,jl,jf) 
     201               DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1-nn_hls+1, jpj   ;   DO ji = 1, nn_hls 
     202                  ARRAY_IN(ji-nn_hls+1,jj,jk,jl,jf) = ARRAY_IN(1+ji,jj,jk,jl,jf) 
    208203               END DO   ;   END DO   ;   END DO   ;   END DO 
    209204            ENDIF 
     
    212207         DO jf = 1, ipf                               ! number of arrays to be treated 
    213208            IF( .NOT. NAT_IN(jf) == 'F' ) THEN        ! do nothing for F point 
    214                DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, ihl 
    215                   ARRAY_IN(ji,jj,jk,jl,jf) = zland 
     209               DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1-nn_hls+1, jpj   ;   DO ji = 1, nn_hls 
     210                  ARRAY_IN(ji-nn_hls+1,jj,jk,jl,jf) = zland 
    216211               END DO;   END DO   ;   END DO   ;   END DO 
    217212            ENDIF 
     
    221216      ! 2.2 fill eastern halo 
    222217      ! --------------------- 
    223       ishift = jpi - ihl                ! fill halo from ji = jpi-ihl+1 to jpi  
     218      ishift = jpi - nn_hls                ! fill halo from ji = jpi-nn_hls+1 to jpi  
    224219      SELECT CASE ( ifill_ea ) 
    225220      CASE ( jpfillnothing )               ! no filling  
    226221      CASE ( jpfillmpi   )                 ! use data received by MPI  
    227          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, ihl 
    228             ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zrcv_ea(ji,jj,jk,jl,jf)   ! jpi - ihl + 1 -> jpi 
     222         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1-nn_hls+1, jpj   ;   DO ji = 1, nn_hls 
     223            ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zrcv_ea(ji,jj,jk,jl,jf)   ! jpi - nn_hls + 1 -> jpi 
    229224         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    230225      CASE ( jpfillperio )                 ! use east-weast periodicity 
    231          ishift2 = ihl 
    232          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, ihl 
     226         ishift2 = 1 
     227         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1-nn_hls+1, jpj   ;   DO ji = 1, nn_hls 
    233228            ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf) 
    234229         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    235230      CASE ( jpfillcopy  )                 ! filling with inner domain values 
    236          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, ihl 
    237             ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ishift,jj,jk,jl,jf) 
     231       ishift2 = jpi - 2*nn_hls 
     232         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1-nn_hls+1, jpj   ;   DO ji = 1, nn_hls 
     233            ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf) 
    238234         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    239235      CASE ( jpfillcst   )                 ! filling with constant value 
    240          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, ihl 
     236         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1-nn_hls+1, jpj   ;   DO ji = 1, nn_hls 
    241237            ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zland 
    242238         END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
     
    264260      ! ---------------------------------------------------- ! 
    265261      ! 
    266       IF( llsend_so )   ALLOCATE( zsnd_so(jpi,ihl,ipk,ipl,ipf) ) 
    267       IF( llsend_no )   ALLOCATE( zsnd_no(jpi,ihl,ipk,ipl,ipf) ) 
    268       IF( llrecv_so )   ALLOCATE( zrcv_so(jpi,ihl,ipk,ipl,ipf) ) 
    269       IF( llrecv_no )   ALLOCATE( zrcv_no(jpi,ihl,ipk,ipl,ipf) ) 
    270       ! 
    271       isize = jpi * ihl * ipk * ipl * ipf       
     262      IF( llsend_so )   ALLOCATE( zsnd_so(1-nn_hls+1:jpi,nn_hls,ipk,ipl,ipf) ) 
     263      IF( llsend_no )   ALLOCATE( zsnd_no(1-nn_hls+1:jpi,nn_hls,ipk,ipl,ipf) ) 
     264      IF( llrecv_so )   ALLOCATE( zrcv_so(1-nn_hls+1:jpi,nn_hls,ipk,ipl,ipf) ) 
     265      IF( llrecv_no )   ALLOCATE( zrcv_no(1-nn_hls+1:jpi,nn_hls,ipk,ipl,ipf) ) 
     266      ! 
     267      isize = ( jpi + nn_hls - 1 ) * nn_hls * ipk * ipl * ipf       
    272268 
    273269      ! allocate local temporary arrays to be sent/received. Fill arrays to be sent 
    274270      IF( llsend_so ) THEN   ! copy sourhern side of the inner mpi domain in local temporary array to be sent by MPI 
    275          ishift = ihl 
    276          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, jpi 
    277             zsnd_so(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift+jj,jk,jl,jf)   ! ihl+1 -> 2*ihl 
     271         ishift = 1 
     272         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1-nn_hls+1, jpi 
     273            zsnd_so(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift+jj,jk,jl,jf)   ! nn_hls+1 -> 2*nn_hls 
    278274         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    279275      ENDIF 
    280276      ! 
    281277      IF( llsend_no ) THEN   ! copy eastern side of the inner mpi domain in local temporary array to be sent by MPI 
    282          ishift = jpj - 2 * ihl 
    283          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, jpi 
    284             zsnd_no(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift+jj,jk,jl,jf)   ! jpj-2*ihl+1 -> jpj-ihl 
     278         ishift = jpj - 2 * nn_hls 
     279         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1-nn_hls+1, jpi 
     280            zsnd_no(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift+jj,jk,jl,jf)   ! jpj-2*nn_hls+1 -> jpj-nn_hls 
    285281         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    286282      ENDIF 
     
    289285      ! 
    290286      ! non-blocking send of the southern/northern side 
    291       IF( llsend_so )   CALL mppsend( 3, zsnd_so(1,1,1,1,1), isize, noso, ireq_so ) 
    292       IF( llsend_no )   CALL mppsend( 4, zsnd_no(1,1,1,1,1), isize, nono, ireq_no ) 
     287      IF( llsend_so )   CALL mppsend( 3, zsnd_so(1-nn_hls+1,1,1,1,1), isize, noso, ireq_so ) 
     288      IF( llsend_no )   CALL mppsend( 4, zsnd_no(1-nn_hls+1,1,1,1,1), isize, nono, ireq_no ) 
    293289      ! blocking receive of the southern/northern halo 
    294       IF( llrecv_so )   CALL mpprecv( 4, zrcv_so(1,1,1,1,1), isize, noso ) 
    295       IF( llrecv_no )   CALL mpprecv( 3, zrcv_no(1,1,1,1,1), isize, nono ) 
     290      IF( llrecv_so )   CALL mpprecv( 4, zrcv_so(1-nn_hls+1,1,1,1,1), isize, noso ) 
     291      IF( llrecv_no )   CALL mpprecv( 3, zrcv_no(1-nn_hls+1,1,1,1,1), isize, nono ) 
    296292      ! 
    297293      IF( ln_timing ) CALL tic_tac(.FALSE.) 
     
    303299      ! 5.1 fill southern halo 
    304300      ! ---------------------- 
    305       ! ishift = 0                         ! fill halo from jj = 1 to ihl 
     301      ! ishift = 0                         ! fill halo from jj = 1 to nn_hls 
    306302      SELECT CASE ( ifill_so ) 
    307303      CASE ( jpfillnothing )               ! no filling  
    308304      CASE ( jpfillmpi   )                 ! use data received by MPI  
    309          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, jpi 
    310             ARRAY_IN(ji,jj,jk,jl,jf) = zrcv_so(ji,jj,jk,jl,jf)   ! 1 -> ihl 
     305         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1-nn_hls+1, jpi 
     306            ARRAY_IN(ji,jj-nn_hls+1,jk,jl,jf) = zrcv_so(ji,jj,jk,jl,jf)   ! 1 -> nn_hls 
    311307         END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
    312308      CASE ( jpfillperio )                 ! use north-south periodicity 
    313          ishift2 = jpj - 2 * ihl 
    314          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, jpi 
    315             ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf) 
     309         ishift2 = jpj - 2 * nn_hls 
     310         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1-nn_hls+1, jpi 
     311            ARRAY_IN(ji,jj-nn_hls+1,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf) 
    316312         END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
    317313      CASE ( jpfillcopy  )                 ! filling with inner domain values 
    318314         DO jf = 1, ipf                               ! number of arrays to be treated 
    319315            IF( .NOT. NAT_IN(jf) == 'F' ) THEN        ! do nothing for F point 
    320                DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, jpi 
    321                   ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ihl+1,jk,jl,jf) 
     316               DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1-nn_hls+1, jpi 
     317                  ARRAY_IN(ji,jj-nn_hls+1,jk,jl,jf) = ARRAY_IN(ji,1+jj,jk,jl,jf) 
    322318               END DO   ;   END DO   ;   END DO   ;   END DO 
    323319            ENDIF 
     
    326322         DO jf = 1, ipf                               ! number of arrays to be treated 
    327323            IF( .NOT. NAT_IN(jf) == 'F' ) THEN        ! do nothing for F point 
    328                DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, jpi  
    329                   ARRAY_IN(ji,jj,jk,jl,jf) = zland 
     324               DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1-nn_hls+1, jpi  
     325                  ARRAY_IN(ji,jj-nn_hls+1,jk,jl,jf) = zland 
    330326               END DO;   END DO   ;   END DO   ;   END DO 
    331327            ENDIF 
     
    335331      ! 5.2 fill northern halo 
    336332      ! ---------------------- 
    337       ishift = jpj - ihl                ! fill halo from jj = jpj-ihl+1 to jpj  
     333      ishift = jpj - nn_hls                ! fill halo from jj = jpj-nn_hls+1 to jpj  
    338334      SELECT CASE ( ifill_no ) 
    339335      CASE ( jpfillnothing )               ! no filling  
    340336      CASE ( jpfillmpi   )                 ! use data received by MPI  
    341          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, jpi 
    342             ARRAY_IN(ji,ishift+jj,jk,jl,jf) = zrcv_no(ji,jj,jk,jl,jf)   ! jpj-ihl+1 -> jpj 
     337         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1-nn_hls+1, jpi 
     338            ARRAY_IN(ji,ishift+jj,jk,jl,jf) = zrcv_no(ji,jj,jk,jl,jf)   ! jpj-nn_hls+1 -> jpj 
    343339         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    344340      CASE ( jpfillperio )                 ! use north-south periodicity 
    345          ishift2 = ihl 
    346          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, jpi 
     341         ishift2 = 1 
     342         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1-nn_hls+1, jpi 
    347343            ARRAY_IN(ji,ishift+jj,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf) 
    348344         END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
    349345      CASE ( jpfillcopy  )                 ! filling with inner domain values 
    350          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, jpi 
    351             ARRAY_IN(ji,ishift+jj,jk,jl,jf) = ARRAY_IN(ji,ishift,jk,jl,jf) 
     346          ishift2 = jpj - 2*nn_hls 
     347         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1-nn_hls+1, jpi 
     348            ARRAY_IN(ji,ishift+jj,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf) 
    352349         END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
    353350      CASE ( jpfillcst   )                 ! filling with constant value 
    354          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, jpi 
     351         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1-nn_hls+1, jpi 
    355352            ARRAY_IN(ji,ishift+jj,jk,jl,jf) = zland 
    356353         END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/mpp_nfd_generic.h90

    r11536 r12586  
    4848   SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn, kfld ) 
    4949      !!---------------------------------------------------------------------- 
    50       ARRAY_TYPE(:,:,:,:,:)   ! array or pointer of arrays on which the boundary condition is applied 
     50      ARRAY_TYPE(1-nn_hls+1:,1-nn_hls+1:,:,:,:)   ! array or pointer of arrays on which the boundary condition is applied 
    5151      CHARACTER(len=1) , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points 
    5252      REAL(wp)         , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary 
     
    5454      ! 
    5555      INTEGER  ::   ji,  jj,  jk,  jl, jh, jf, jr   ! dummy loop indices 
    56       INTEGER  ::   ipi, ipj, ipk, ipl, ipf         ! dimension of the input array 
     56      INTEGER  ::   ipi, ipk, ipl, ipf         ! dimension of the input array 
    5757      INTEGER  ::   imigr, iihom, ijhom             ! local integers 
    5858      INTEGER  ::   ierr, ibuffsize, ilci, ildi, ilei, iilb 
     
    8080         ALLOCATE(ipj_s(ipf)) 
    8181 
    82          ipj      = 2            ! Max 2nd dimension of message transfers (last two j-line only) 
    83          ipj_s(:) = 1            ! Real 2nd dimension of message transfers (depending on perf requirement) 
     82         ijpj      = 2 + nn_hls - 1           ! Max 2nd dimension of message transfers (last two j-line only) 
     83         ipj_s(:) = 1 + nn_hls - 1           ! Real 2nd dimension of message transfers (depending on perf requirement) 
    8484                                 ! by default, only one line is exchanged 
    8585 
    86          ALLOCATE( jj_s(ipf,2) ) 
     86         ALLOCATE( jj_s(ipf,ijpj) ) 
    8787 
    8888         ! re-define number of exchanged lines : 
     
    9898         IF ( l_full_nf_update .OR.                          &    ! if coupling fields 
    9999              ( ncom_stp == nit000 .AND. .NOT. ln_rstart ) ) &    ! at first time step, if not restart 
    100             ipj_s(:) = 2 
     100            ipj_s(:) = 2 + nn_hls - 1  
    101101 
    102102         ! Index of modifying lines in input 
     
    110110               ! 
    111111               CASE ( 'T' , 'W' ,'U' )                            ! T-, U-, W-point 
    112                   jj_s(jf,1) = nlcj - 2 ;  jj_s(jf,2) = nlcj - 1 
     112                     DO ji = 1, nn_hls+1 
     113                  jj_s(jf,ji) = nlcj - 2*nn_hls +ji -1 
     114               ENDDO 
    113115               CASE ( 'V' , 'F' )                                 ! V-, F-point 
    114                   jj_s(jf,1) = nlcj - 3 ;  jj_s(jf,2) = nlcj - 2 
     116               DO ji = 1, nn_hls+1 
     117                  jj_s(jf,ji) = nlcj - 2*nn_hls +ji - 2 
     118               ENDDO 
    115119               END SELECT 
    116120            ! 
     
    119123               ! 
    120124               CASE ( 'T' , 'W' ,'U' )                            ! T-, U-, W-point 
    121                   jj_s(jf,1) = nlcj - 1       
    122                   ipj_s(jf) = 1                  ! need only one line anyway 
     125               DO ji = 1, nn_hls 
     126                  jj_s(jf,ji) = nlcj - 2*nn_hls + ji      
     127               ENDDO 
     128               ipj_s(jf) = nn_hls                  ! need only one line anyway 
    123129               CASE ( 'V' , 'F' )                                 ! V-, F-point 
    124                   jj_s(jf,1) = nlcj - 2 ;  jj_s(jf,2) = nlcj - 1 
     130               DO ji = 1, nn_hls+1 
     131                  jj_s(jf,ji) = nlcj - 2*nn_hls +ji -1 
     132               ENDDO 
    125133               END SELECT 
    126134            ! 
     
    131139         ipf_j = sum (ipj_s(:))      ! Total number of lines to be exchanged 
    132140         ! 
    133          ALLOCATE( znorthloc(jpimax,ipf_j,ipk,ipl,1) ) 
     141         ALLOCATE( znorthloc(1-nn_hls+1:jpimax,ipf_j,ipk,ipl,1) ) 
    134142         ! 
    135143         js = 0 
     
    139147               DO jl = 1, ipl 
    140148                  DO jk = 1, ipk 
    141                      znorthloc(1:jpi,js,jk,jl,1) = ARRAY_IN(1:jpi,jj_s(jf,jj),jk,jl,jf) 
     149                     znorthloc(1-nn_hls+1:jpi,js,jk,jl,1) = ARRAY_IN(1-nn_hls+1:jpi,jj_s(jf,jj),jk,jl,jf) 
    142150                  END DO 
    143151               END DO 
     
    145153         END DO 
    146154         ! 
    147          ibuffsize = jpimax * ipf_j * ipk * ipl 
    148          ! 
    149          ALLOCATE( zfoldwk(jpimax,ipf_j,ipk,ipl,1) ) 
    150          ALLOCATE( ztabr(jpimax*jpmaxngh,ipj,ipk,ipl,ipf) )  
     155         ibuffsize = (jpimax + nn_hls -1) * ipf_j * ipk * ipl 
     156         ! 
     157         ALLOCATE( zfoldwk(1-nn_hls+1:jpimax,ipf_j,ipk,ipl,1) ) 
     158         ALLOCATE( ztabr(1-nn_hls+1:(jpi+nn_hls-1)*jpmaxngh-nn_hls+1,ijpj,ipk,ipl,ipf) )  
    151159         ! when some processors of the north fold are suppressed,  
    152160         ! values of ztab* arrays corresponding to these suppressed domain won't be defined  
     
    218226      ELSE                             !==  allgather exchanges  ==! 
    219227         ! 
    220          ipj   = 4            ! 2nd dimension of message transfers (last j-lines) 
    221          ! 
    222          ALLOCATE( znorthloc(jpimax,ipj,ipk,ipl,ipf) ) 
    223          ! 
    224          DO jf = 1, ipf                ! put in znorthloc the last ipj j-lines of ptab 
     228         ijpj   = 4            ! 2nd dimension of message transfers (last j-lines) 
     229         ! 
     230         ALLOCATE( znorthloc(jpimax,ijpj,ipk,ipl,ipf) ) 
     231         ! 
     232         DO jf = 1, ipf                ! put in znorthloc the last ijpj j-lines of ptab 
    225233            DO jl = 1, ipl 
    226234               DO jk = 1, ipk 
    227                   DO jj = nlcj - ipj +1, nlcj 
    228                      ij = jj - nlcj + ipj 
     235                  DO jj = nlcj - ijpj +1, nlcj 
     236                     ij = jj - nlcj + ijpj 
    229237                     znorthloc(1:jpi,ij,jk,jl,jf) = ARRAY_IN(1:jpi,jj,jk,jl,jf) 
    230238                  END DO 
     
    233241         END DO 
    234242         ! 
    235          ibuffsize = jpimax * ipj * ipk * ipl * ipf 
    236          ! 
    237          ALLOCATE( ztab       (jpiglo,ipj,ipk,ipl,ipf     ) ) 
    238          ALLOCATE( znorthgloio(jpimax,ipj,ipk,ipl,ipf,jpni) ) 
     243         ibuffsize = jpimax * ijpj * ipk * ipl * ipf 
     244         ! 
     245         ALLOCATE( ztab       (jpiglo,ijpj,ipk,ipl,ipf     ) ) 
     246         ALLOCATE( znorthgloio(jpimax,ijpj,ipk,ipl,ipf,jpni) ) 
    239247         ! 
    240248         ! when some processors of the north fold are suppressed, 
     
    263271               DO jl = 1, ipl 
    264272                  DO jk = 1, ipk 
    265                      DO jj = 1, ipj 
     273                     DO jj = 1, ijpj 
    266274                        DO ji = ildi, ilei 
    267275                           ztab(ji+iilb-1,jj,jk,jl,jf) = znorthgloio(ji,jj,jk,jl,jf,jr) 
     
    279287            DO jl = 1, ipl 
    280288               DO jk = 1, ipk 
    281                   DO jj = nlcj-ipj+1, nlcj             ! Scatter back to ARRAY_IN 
    282                      ij = jj - nlcj + ipj 
     289                  DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to ARRAY_IN 
     290                     ij = jj - nlcj + ijpj 
    283291                     DO ji= 1, nlci 
    284292                        ARRAY_IN(ji,jj,jk,jl,jf) = ztab(ji+nimpp-1,ij,jk,jl,jf) 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/mppini.F90

    r12377 r12586  
    2525   USE bdy_oce        ! open BounDarY   
    2626   ! 
    27    USE lbcnfd  , ONLY : isendto, nsndto, nfsloop, nfeloop  ! Setup of north fold exchanges  
     27   USE lbcnfd  , ONLY : isendto, nsndto ! Setup of north fold exchanges  
    2828   USE lib_mpp        ! distribued memory computing library 
    2929   USE iom            ! nemo I/O library  
     
    699699            WRITE(inum,*) 
    700700            WRITE(inum,*) 'north fold exchanges with explicit point-to-point messaging :' 
    701             WRITE(inum,*) 'nfsloop : ', nfsloop 
    702             WRITE(inum,*) 'nfeloop : ', nfeloop 
    703701            WRITE(inum,*) 'nsndto : ', nsndto 
    704702            WRITE(inum,*) 'isendto : ', isendto 
     
    12611259            ! 
    12621260         END DO 
    1263          nfsloop = 1 
    1264          nfeloop = nlci 
    1265          DO jn = 2,jpni-1 
    1266             IF( nfipproc(jn,jpnj) == (narea - 1) ) THEN 
    1267                IF( nfipproc(jn-1,jpnj) == -1 )   nfsloop = nldi 
    1268                IF( nfipproc(jn+1,jpnj) == -1 )   nfeloop = nlei 
    1269             ENDIF 
    1270          END DO 
    12711261         ! 
    12721262      ENDIF 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/SBC/sbcrnf.F90

    r12489 r12586  
    5959   INTEGER , PUBLIC ::   nkrnf = 0            !: nb of levels over which Kz is increased at river mouths 
    6060    
    61    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   rnfmsk              !: river mouth mask (hori.) 
     61   REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:)   ::   rnfmsk              !: river mouth mask (hori.) 
    6262   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:)     ::   rnfmsk_z            !: river mouth mask (vert.) 
    6363   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   h_rnf               !: depth of runoff in m 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/TRA/traadv.F90

    r12489 r12586  
    8383      INTEGER                                  , INTENT(in)    :: kt             ! ocean time-step index 
    8484      INTEGER                                  , INTENT(in)    :: Kbb, Kmm, Krhs ! time level indices 
    85       REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts            ! active tracers and RHS of tracer equation 
     85      REAL(wp), POINTER, DIMENSION(:,:,:,:,:)  , INTENT(inout) :: pts            ! active tracers and RHS of tracer equation 
    8686      ! 
    8787      INTEGER ::   jk   ! dummy loop index 
    88       REAL(wp), DIMENSION(jpi,jpj,jpk)        :: zuu, zvv, zww   ! 3D workspace 
     88      REAL(wp), POINTER, DIMENSION(:,:,:)        :: zuu, zvv, zww   ! 3D workspace 
    8989      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::   ztrdt, ztrds 
    9090      !!---------------------------------------------------------------------- 
    9191      ! 
    9292      IF( ln_timing )   CALL timing_start('tra_adv') 
     93      ALLOCATE( zuu(jpi,jpj,jpk), zvv(jpi,jpj,jpk), zww(jpi,jpj,jpk) ) 
    9394      ! 
    9495      !                                         !==  effective transport  ==! 
     
    167168         &                                  tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2=       ' Sa: ', mask2=tmask, clinfo3='tra' ) 
    168169      ! 
     170      DEALLOCATE( zuu, zvv, zww ) 
    169171      IF( ln_timing )   CALL timing_stop( 'tra_adv' ) 
    170172      ! 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/TRA/traadv_mus.F90

    r12377 r12586  
    3131   USE lbclnk         ! ocean lateral boundary condition (or mpp link)  
    3232   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined)   
     33   USE halo_mng 
    3334 
    3435   IMPLICIT NONE 
     
    3738   PUBLIC   tra_adv_mus   ! routine called by traadv.F90 
    3839    
    39    REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   upsmsk   !: mixed upstream/centered scheme near some straits 
     40   REAL(wp), POINTER, SAVE, DIMENSION(:,:)   ::   upsmsk   !: mixed upstream/centered scheme near some straits 
    4041   !                                                           !  and in closed seas (orca 2 and 1 configurations) 
    4142   REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   xind     !: mixed upstream/centered index 
     
    4445   LOGICAL  ::   l_ptr   ! flag to compute poleward transport 
    4546   LOGICAL  ::   l_hst   ! flag to compute heat/salt transport 
     47 
     48   INTEGER :: jphls = 2 
    4649 
    4750   !! * Substitutions 
     
    8083      LOGICAL                                  , INTENT(in   ) ::   ld_msc_ups      ! use upstream scheme within muscl 
    8184      REAL(wp)                                 , INTENT(in   ) ::   p2dt            ! tracer time-step 
    82       REAL(wp), DIMENSION(jpi,jpj,jpk         ), INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume flux components 
    83       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) ::   pt              ! tracers and RHS of tracer equation 
     85      REAL(wp), POINTER, DIMENSION(:,:,:    )           , INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume flux components 
     86      REAL(wp), POINTER, DIMENSION(:,:,:,:,:)           , INTENT(inout) ::   pt              ! tracers and RHS of tracer equation 
    8487      ! 
    8588      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
     
    8790      REAL(wp) ::   zu, z0u, zzwx, zw , zalpha   ! local scalars 
    8891      REAL(wp) ::   zv, z0v, zzwy, z0w           !   -      - 
    89       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwx, zslpx   ! 3D workspace 
    90       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zwy, zslpy   ! -      -  
     92      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zwx, zslpx   ! 3D workspace 
     93      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   zwy, zslpy   ! -      -  
    9194      !!---------------------------------------------------------------------- 
    9295      ! 
     96      CALL halo_mng_set(jphls) 
     97 
     98      ALLOCATE(zwx(jplbi:jpi,jplbj:jpj,jpk)) 
     99      ALLOCATE(zwy(jplbi:jpi,jplbj:jpj,jpk)) 
     100      ALLOCATE(zslpx(jplbi:jpi,jplbj:jpj,jpk)) 
     101      ALLOCATE(zslpy(jplbi:jpi,jplbj:jpj,jpk)) 
     102 
     103      CALL halo_mng_resize(r1_e1e2t,'T', 1._wp) 
     104      CALL halo_mng_resize(r1_e1e2u,'U', 1._wp) 
     105      CALL halo_mng_resize(r1_e1e2v,'V', 1._wp) 
     106      CALL halo_mng_resize(tmask,'T', 1._wp) 
     107      CALL halo_mng_resize(wmask, 'W', 1._wp) 
     108      CALL halo_mng_resize(umask, 'U', 1._wp) 
     109      CALL halo_mng_resize(vmask, 'V', 1._wp) 
     110      CALL halo_mng_resize(pt, 'T', 1._wp, kjpt=kjpt, fjpt=Kbb ) 
     111      CALL halo_mng_resize(pt, 'T', 1._wp, kjpt=kjpt, fjpt=Krhs ) 
     112      CALL halo_mng_resize(e3t,'T', 1._wp, fillval=1._wp, fjpt=Kmm) 
     113      CALL halo_mng_resize(e3u, 'U', 1._wp, fillval=1._wp, fjpt=Kmm ) 
     114      CALL halo_mng_resize(e3v, 'V', 1._wp, fillval=1._wp, fjpt=Kmm) 
     115      CALL halo_mng_resize(e3w, 'W', 1._wp, fillval=1._wp, fjpt=Kmm) 
     116      CALL halo_mng_resize(pU, 'U', 1._wp) 
     117      CALL halo_mng_resize(pV, 'V', 1._wp) 
     118      CALL halo_mng_resize(pW, 'W', 1._wp) 
     119      !       
     120      IF( ln_isfcav ) CALL halo_mng_resize(mikt, 'T', 1._wp) 
     121      IF( ld_msc_ups) CALL halo_mng_resize(rnfmsk, 'T', 1._wp) 
     122      IF( ld_msc_ups) CALL halo_mng_resize(upsmsk, 'T', 1._wp) 
     123 
    93124      IF( kt == kit000 )  THEN 
    94125         IF(lwp) WRITE(numout,*) 
     
    100131         ! Upstream / MUSCL scheme indicator 
    101132         ! 
    102          ALLOCATE( xind(jpi,jpj,jpk), STAT=ierr ) 
     133         ALLOCATE( xind(jplbi:jpi,jplbj:jpj,jpk), STAT=ierr ) 
    103134         xind(:,:,:) = 1._wp              ! set equal to 1 where up-stream is not needed 
    104135         ! 
    105136         IF( ld_msc_ups ) THEN            ! define the upstream indicator (if asked) 
    106             ALLOCATE( upsmsk(jpi,jpj), STAT=ierr ) 
     137            ALLOCATE( upsmsk(jplbi:jpi,jplbj:jpj), STAT=ierr ) 
    107138            upsmsk(:,:) = 0._wp                             ! not upstream by default 
    108139            ! 
     
    115146         ! 
    116147      ENDIF  
    117       !       
     148 
    118149      l_trd = .FALSE. 
    119150      l_hst = .FALSE. 
     
    131162         zwx(:,:,jpk) = 0._wp                   ! bottom values 
    132163         zwy(:,:,jpk) = 0._wp   
    133          DO_3D_10_10( 1, jpkm1 ) 
     164         DO_3D_20_20( 1, jpkm1 ) 
    134165            zwx(ji,jj,jk) = umask(ji,jj,jk) * ( pt(ji+1,jj,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 
    135166            zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( pt(ji,jj+1,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 
    136167         END_3D 
    137168         ! lateral boundary conditions   (changed sign) 
    138          CALL lbc_lnk_multi( 'traadv_mus', zwx, 'U', -1. , zwy, 'V', -1. ) 
     169         CALL lbc_lnk( 'traadv_mus', zwx, 'U', -1. )   ! lateral boundary conditions   (changed sign) 
     170         CALL lbc_lnk( 'traadv_mus', zwy, 'V', -1. )   ! lateral boundary conditions   (changed sign) 
    139171         !                                !-- Slopes of tracer 
    140172         zslpx(:,:,jpk) = 0._wp                 ! bottom values 
    141173         zslpy(:,:,jpk) = 0._wp 
    142          DO_3D_01_01( 1, jpkm1 ) 
     174         DO_3D_31_31( 1, jpkm1 ) 
    143175            zslpx(ji,jj,jk) =                    ( zwx(ji,jj,jk) + zwx(ji-1,jj  ,jk) )   & 
    144176               &            * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji-1,jj  ,jk) ) ) 
     
    147179         END_3D 
    148180         ! 
    149          DO_3D_01_01( 1, jpkm1 ) 
     181         DO_3D_31_31( 1, jpkm1 ) 
    150182            zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji  ,jj,jk) ),   & 
    151183               &                                                 2.*ABS( zwx  (ji-1,jj,jk) ),   & 
     
    156188         END_3D 
    157189         ! 
    158          DO_3D_00_00( 1, jpkm1 ) 
     190         DO_3D_30_30( 1, jpkm1 ) 
    159191            ! MUSCL fluxes 
    160192            z0u = SIGN( 0.5, pU(ji,jj,jk) ) 
     
    172204            zwy(ji,jj,jk) = pV(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 
    173205         END_3D 
    174          CALL lbc_lnk_multi( 'traadv_mus', zwx, 'U', -1. , zwy, 'V', -1. )   ! lateral boundary conditions   (changed sign) 
    175          ! 
    176          DO_3D_00_00( 1, jpkm1 ) 
     206         CALL lbc_lnk( 'traadv_mus', zwx, 'U', -1. )   ! lateral boundary conditions   (changed sign) 
     207         CALL lbc_lnk( 'traadv_mus', zwy, 'V', -1. )   ! lateral boundary conditions   (changed sign) 
     208         ! 
     209         DO_3D_30_30( 1, jpkm1 ) 
    177210            pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )       & 
    178211            &                                     + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  ) )     & 
     
    199232         !                                !-- Slopes of tracer 
    200233         zslpx(:,:,1) = 0._wp                   ! surface values 
    201          DO_3D_11_11( 2, jpkm1 ) 
     234         DO_3D_21_21( 2, jpkm1 ) 
    202235            zslpx(ji,jj,jk) =                     ( zwx(ji,jj,jk) + zwx(ji,jj,jk+1) )  & 
    203236               &            * (  0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji,jj,jk+1) )  ) 
    204237         END_3D 
    205          DO_3D_11_11( 2, jpkm1 ) 
     238         DO_3D_21_21( 2, jpkm1 ) 
    206239            zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji,jj,jk  ) ),   & 
    207240               &                                                 2.*ABS( zwx  (ji,jj,jk+1) ),   & 
    208241               &                                                 2.*ABS( zwx  (ji,jj,jk  ) )  ) 
    209242         END_3D 
    210          DO_3D_00_00( 1, jpk-2 ) 
     243         DO_3D_30_30( 1, jpk-2 ) 
    211244            z0w = SIGN( 0.5, pW(ji,jj,jk+1) ) 
    212245            zalpha = 0.5 + z0w 
     
    218251         IF( ln_linssh ) THEN                   ! top values, linear free surface only 
    219252            IF( ln_isfcav ) THEN                      ! ice-shelf cavities (top of the ocean) 
    220                DO_2D_11_11 
     253               DO_2D_21_21 
    221254                  zwx(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kbb) 
    222255               END_2D 
     
    226259         ENDIF 
    227260         ! 
    228          DO_3D_00_00( 1, jpkm1 ) 
     261         DO_3D_30_30( 1, jpkm1 ) 
    229262            pt(ji,jj,jk,jn,Krhs) =  pt(ji,jj,jk,jn,Krhs) - ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
    230263         END_3D 
     
    234267      END DO                     ! end of tracer loop 
    235268      ! 
     269      DEALLOCATE(zwx,zwy) 
     270      DEALLOCATE(zslpx,zslpy) 
     271 
     272      CALL halo_mng_set(1) 
     273 
     274      CALL halo_mng_resize(r1_e1e2t,'T', 1._wp) 
     275      CALL halo_mng_resize(r1_e1e2u,'U', 1._wp) 
     276      CALL halo_mng_resize(r1_e1e2v,'V', 1._wp) 
     277      CALL halo_mng_resize(pt, 'T', 1._wp, kjpt=kjpt, fjpt=Kbb ) 
     278      CALL halo_mng_resize(pt, 'T', 1._wp, kjpt=kjpt, fjpt=Krhs ) 
     279      CALL halo_mng_resize(tmask,'T', 1._wp) 
     280      CALL halo_mng_resize(wmask, 'W', 1._wp) 
     281      CALL halo_mng_resize(umask, 'U', 1._wp) 
     282      CALL halo_mng_resize(vmask, 'V', 1._wp) 
     283      CALL halo_mng_resize(e3t,'T', 1._wp, fillval=1._wp, fjpt=Kmm) 
     284      CALL halo_mng_resize(e3u, 'U', 1._wp, fillval=1._wp, fjpt=Kmm) 
     285      CALL halo_mng_resize(e3v, 'V', 1._wp, fillval=1._wp, fjpt=Kmm) 
     286      CALL halo_mng_resize(e3w, 'W', 1._wp, fillval=1._wp, fjpt=Kmm) 
     287      CALL halo_mng_resize(pU, 'U', 1._wp) 
     288      CALL halo_mng_resize(pV, 'V', 1._wp) 
     289      CALL halo_mng_resize(pW, 'W', 1._wp) 
     290 
     291      IF( ln_isfcav ) CALL halo_mng_resize(mikt, 'T', 1._wp) 
     292      IF( ld_msc_ups) CALL halo_mng_resize(rnfmsk, 'T', 1._wp) 
     293      IF( ld_msc_ups) CALL halo_mng_resize(upsmsk, 'T', 1._wp) 
     294 
    236295   END SUBROUTINE tra_adv_mus 
    237296 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/ZDF/zdfdrg.F90

    r12489 r12586  
    268268      IF( ln_isfcav ) THEN              ! Ocean cavities: top friction setting 
    269269         ALLOCATE( rCd0_top(jpi,jpj), rCdU_top(jpi,jpj) ) 
    270          CALL drg_init( 'TOP   '   , mikt       ,                                         &   ! <== in 
     270         CALL drg_init( 'TOP   '   , INT(mikt)       ,                                         &   ! <== in 
    271271            &           r_Cdmin_top, r_Cdmax_top, r_z0_top, r_ke0_top, rCd0_top, rCdU_top )   ! ==> out 
    272272      ENDIF 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/ZDF/zdfphy.F90

    r12377 r12586  
    247247            &                                        rCdU_bot  )     ! ==>> out : bottom drag [m/s] 
    248248         IF( ln_isfcav ) THEN    !* top drag   (ocean cavities) 
    249             CALL zdf_drg( kt, Kmm, mikt , r_Cdmin_top, r_Cdmax_top,   &   ! <<== in  
     249            CALL zdf_drg( kt, Kmm, INT(mikt) , r_Cdmin_top, r_Cdmax_top,   &   ! <<== in  
    250250               &              r_z0_top,   r_ke0_top,    rCd0_top,   & 
    251251               &                                        rCdU_top  )     ! ==>> out : bottom drag [m/s] 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/do_loop_substitute.h90

    r12377 r12586  
    5959#define __kIsm1_   1 
    6060#define __kJsm1_   1 
     61# 
     62#define __kIsmh_   jplbi 
     63#define __kJsmh_   jplbj 
     64#define __kIsmhp1_   jplbi+1 
     65#define __kJsmhp1_   jplbj+1 
    6166 
    62 #define __kIe_     jpim1 
    63 #define __kJe_     jpjm1 
     67#define __kIe_     jpi-1 
     68#define __kJe_     jpj-1 
    6469#define __kIep1_   jpi 
    6570#define __kJep1_   jpj 
     
    7883#define DO_2D_10_10   DO jj = __kJsm1_, __kJe_   ;   DO ji = __kIsm1_, __kIe_ 
    7984#define DO_2D_10_11   DO jj = __kJsm1_, __kJe_   ;   DO ji = __kIsm1_, __kIep1_ 
     85# 
     86#define DO_2D_20_20   DO jj = __kJsmh_, __kJe_   ;   DO ji = __kIsmh_, __kIe_ 
     87#define DO_2D_21_21   DO jj = __kJsmh_, __kJep1_   ;   DO ji = __kIsmh_, __kIep1_ 
     88#define DO_2D_31_31   DO jj = __kJsmhp1_, __kJep1_ ;   DO ji = __kIsmhp1_, __kIep1_ 
     89#define DO_2D_30_30   DO jj = __kJsmhp1_, __kJe_   ;   DO ji = __kIsmhp1_, __kIe_ 
    8090  
    8191#define DO_2D_11_00   DO jj = __kJsm1_, __kJep1_   ;   DO ji = __kIs_, __kIe_ 
     
    92102#define DO_3D_10_10(ks,ke)   DO jk = ks, ke   ;   DO_2D_10_10 
    93103#define DO_3D_10_11(ks,ke)   DO jk = ks, ke   ;   DO_2D_10_11 
     104# 
     105#define DO_3D_20_20(ks,ke)   DO jk = ks, ke   ;   DO_2D_20_20 
     106#define DO_3D_21_21(ks,ke)   DO jk = ks, ke   ;   DO_2D_21_21 
     107#define DO_3D_31_31(ks,ke)   DO jk = ks, ke   ;   DO_2D_31_31 
     108#define DO_3D_30_30(ks,ke)   DO jk = ks, ke   ;   DO_2D_30_30 
    94109  
    95110#define DO_3D_11_11(ks,ke)   DO jk = ks, ke   ;   DO_2D_11_11 
     111#define DO_3D_21_21(ks,ke)   DO jk = ks, ke   ;   DO_2D_21_21 
    96112 
    97113#define DO_3DS_00_00(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_00_00 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/nemogcm.F90

    r12489 r12586  
    8686   USE lib_mpp        ! distributed memory computing 
    8787   USE mppini         ! shared/distributed memory setting (mpp_init routine) 
    88    USE lbcnfd  , ONLY : isendto, nsndto, nfsloop, nfeloop   ! Setup of north fold exchanges  
     88   USE lbcnfd  , ONLY : isendto, nsndto  ! Setup of north fold exchanges  
    8989   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    9090#if defined key_iomput 
     
    9494   USE agrif_all_update   ! Master Agrif update 
    9595#endif 
     96   USE halo_mng 
    9697 
    9798   IMPLICIT NONE 
     
    276277      ! 
    277278      cxios_context = 'nemo' 
     279      nn_hls = 1 
    278280      ! 
    279281      !                             !-------------------------------------------------! 
     
    402404      CALL mpp_init 
    403405 
     406      CALL halo_mng_init() 
    404407      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays 
    405408      CALL nemo_alloc() 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/oce.F90

    r12489 r12586  
    2424   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   wi             !: vertical vel. (adaptive-implicit) [m/s] 
    2525   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   hdiv           !: horizontal divergence        [s-1] 
    26    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) ::   ts             !: 4D T-S fields                  [Celsius,psu]  
     26   REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:,:,:) ::   ts             !: 4D T-S fields                  [Celsius,psu]  
    2727   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)   ::   rab_b,  rab_n  !: thermal/haline expansion coef. [Celsius-1,psu-1] 
    2828   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   rn2b ,  rn2    !: brunt-vaisala frequency**2     [s-2] 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/par_oce.F90

    r12377 r12586  
    6161   INTEGER, PUBLIC ::   jpimax! = ( jpiglo-2*nn_hls + (jpni-1) ) / jpni + 2*nn_hls !: maximum jpi 
    6262   INTEGER, PUBLIC ::   jpjmax! = ( jpjglo-2*nn_hls + (jpnj-1) ) / jpnj + 2*nn_hls !: maximum jpj 
     63   INTEGER, PUBLIC ::   jplbi 
     64   INTEGER, PUBLIC ::   jplbj 
    6365 
    6466   !!--------------------------------------------------------------------- 
     
    7880   INTEGER, PUBLIC, PARAMETER ::   jpr2di = 0   !: number of columns for extra outer halo  
    7981   INTEGER, PUBLIC, PARAMETER ::   jpr2dj = 0   !: number of rows    for extra outer halo  
    80    INTEGER, PUBLIC, PARAMETER ::   nn_hls = 1   !: halo width (applies to both rows and columns) 
     82   INTEGER, PUBLIC            ::   nn_hls       !: halo width (applies to both rows and columns) 
    8183 
    8284   !!---------------------------------------------------------------------- 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OFF/nemogcm.F90

    r12377 r12586  
    5959   USE timing         ! Timing 
    6060   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    61    USE lbcnfd  , ONLY : isendto, nsndto, nfsloop, nfeloop   ! Setup of north fold exchanges 
     61   USE lbcnfd  , ONLY : isendto, nsndto   ! Setup of north fold exchanges 
    6262   USE step, ONLY : Nbb, Nnn, Naa, Nrhs   ! time level indices 
     63   USE halo_mng 
    6364 
    6465   IMPLICIT NONE 
     
    182183      ! 
    183184      cxios_context = 'nemo' 
     185      nn_hls = 1 
    184186      ! 
    185187      !                             !-------------------------------------------------! 
     
    296298      CALL mpp_init 
    297299 
     300      CALL halo_mng_init() 
    298301      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays 
    299302      CALL nemo_alloc() 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/SAO/nemogcm.F90

    r12377 r12586  
    3131   USE lib_mpp        ! distributed memory computing 
    3232   USE mppini         ! shared/distributed memory setting (mpp_init routine) 
    33    USE lbcnfd  , ONLY : isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges  
     33   USE lbcnfd  , ONLY : isendto, nsndto ! Setup of north fold exchanges  
    3434   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    3535#if defined key_iomput 
    3636   USE xios           ! xIOserver 
    3737#endif 
     38   USE halo_mng 
    3839 
    3940   IMPLICIT NONE 
     
    9899      ! 
    99100      cxios_context = 'nemo' 
     101      nn_hls = 1 
    100102      ! 
    101103      !                             !-------------------------------------------------! 
     
    224226      CALL mpp_init 
    225227 
     228      CALL halo_mng_init() 
    226229      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays 
    227230      CALL nemo_alloc() 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/SAS/nemogcm.F90

    r12489 r12586  
    3737   USE lib_mpp        ! distributed memory computing 
    3838   USE mppini         ! shared/distributed memory setting (mpp_init routine) 
    39    USE lbcnfd  , ONLY : isendto, nsndto, nfsloop, nfeloop  ! Setup of north fold exchanges 
     39   USE lbcnfd  , ONLY : isendto, nsndto ! Setup of north fold exchanges 
    4040   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    4141#if defined key_iomput 
     
    4545   USE agrif_ice_update ! ice update 
    4646#endif 
     47   USE halo_mng 
    4748 
    4849   IMPLICIT NONE 
     
    207208      ELSE                  ;   cxios_context = 'nemo' 
    208209      ENDIF 
     210      nn_hls = 1 
    209211      ! 
    210212      !                             !-------------------------------------------------! 
     
    345347      CALL mpp_init 
    346348 
     349      CALL halo_mng_init() 
    347350      ! Now we know the dimensions of the grid and numout has been set: we can allocate arrays 
    348351      CALL nemo_alloc() 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/TRP/trcadv.F90

    r12489 r12586  
    7676      INTEGER                                   , INTENT(in)    :: kt   ! ocean time-step index 
    7777      INTEGER                                   , INTENT(in)    :: Kbb, Kmm, Krhs ! time level indices 
    78       REAL(wp), DIMENSION(jpi,jpj,jpk,jptra,jpt), INTENT(inout) :: ptr            ! passive tracers and RHS of tracer equation 
     78      REAL(wp), POINTER, DIMENSION(:,:,:,:,:)   , INTENT(inout) :: ptr            ! passive tracers and RHS of tracer equation 
    7979      ! 
    8080      INTEGER ::   jk   ! dummy loop index 
    8181      CHARACTER (len=22) ::   charout 
    82       REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zuu, zvv, zww  ! effective velocity 
     82      REAL(wp), POINTER, DIMENSION(:,:,:) ::   zuu, zvv, zww  ! effective velocity 
    8383      !!---------------------------------------------------------------------- 
    8484      ! 
    8585      IF( ln_timing )   CALL timing_start('trc_adv') 
     86      ALLOCATE( zuu(jpi,jpj,jpk), zvv(jpi,jpj,jpk), zww(jpi,jpj,jpk) ) 
    8687      ! 
    8788      !                                         !==  effective transport  ==! 
     
    143144      IF( ln_timing )   CALL timing_stop('trc_adv') 
    144145      ! 
     146      DEALLOCATE( zuu, zvv, zww ) 
    145147   END SUBROUTINE trc_adv 
    146148 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/TOP/trc.F90

    r12489 r12586  
    3333   REAL(wp), PUBLIC                                        ::  areatot        !: total volume  
    3434   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  ) ::  cvol           !: volume correction -degrad option-  
    35    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) ::  tr           !: tracer concentration  
     35   REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:,:,:) ::  tr           !: tracer concentration  
    3636   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  ) ::  sbc_trc_b      !: Before sbc fluxes for tracers 
    3737   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  ) ::  sbc_trc        !: Now sbc fluxes for tracers 
Note: See TracChangeset for help on using the changeset viewer.