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 13252 – NEMO

Changeset 13252


Ignore:
Timestamp:
2020-07-06T10:23:31+02:00 (4 years ago)
Author:
smasson
Message:

Extra_Halo: work with ln_nnogather = F, see #2366

Location:
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src
Files:
5 edited

Legend:

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

    r13247 r13252  
    13781378         DO ji = 1, jpi 
    13791379            DO jj = 1, jpj              
    1380               IF (((ji + nimpp - 1) == jpiwob(ib)).AND. &  
    1381                &  ((jj + njmpp - 1) == jpjwdt(ib))) ztestmask(1)=tmask(ji,jj,1) 
    1382               IF (((ji + nimpp - 1) == jpiwob(ib)).AND. &  
    1383                &  ((jj + njmpp - 1) == jpjwft(ib))) ztestmask(2)=tmask(ji,jj,1)   
     1380              IF( mig(ji) == jpiwob(ib) .AND. mjg(jj) == jpjwdt(ib) )   ztestmask(1) = tmask(ji,jj,1) 
     1381              IF( mig(ji) == jpiwob(ib) .AND. mjg(jj) == jpjwft(ib) )   ztestmask(2) = tmask(ji,jj,1)   
    13841382            END DO 
    13851383         END DO 
     
    14161414         DO ji = 1, jpi 
    14171415            DO jj = 1, jpj              
    1418               IF (((ji + nimpp - 1) == jpieob(ib)+1).AND. &  
    1419                &  ((jj + njmpp - 1) == jpjedt(ib))) ztestmask(1)=tmask(ji,jj,1) 
    1420               IF (((ji + nimpp - 1) == jpieob(ib)+1).AND. &  
    1421                &  ((jj + njmpp - 1) == jpjeft(ib))) ztestmask(2)=tmask(ji,jj,1)   
     1416              IF( mig(ji) == jpieob(ib)+1 .AND. mjg(jj) == jpjedt(ib) )   ztestmask(1) = tmask(ji,jj,1) 
     1417              IF( mig(ji) == jpieob(ib)+1 .AND. mjg(jj) == jpjeft(ib) )   ztestmask(2) = tmask(ji,jj,1)   
    14221418            END DO 
    14231419         END DO 
     
    14541450         DO ji = 1, jpi 
    14551451            DO jj = 1, jpj              
    1456               IF (((jj + njmpp - 1) == jpjsob(ib)).AND. &  
    1457                &  ((ji + nimpp - 1) == jpisdt(ib))) ztestmask(1)=tmask(ji,jj,1) 
    1458               IF (((jj + njmpp - 1) == jpjsob(ib)).AND. &  
    1459                &  ((ji + nimpp - 1) == jpisft(ib))) ztestmask(2)=tmask(ji,jj,1)   
     1452              IF( mjg(jj) == jpjsob(ib) .AND. mig(ji) == jpisdt(ib) )   ztestmask(1) = tmask(ji,jj,1) 
     1453              IF( mjg(jj) == jpjsob(ib) .AND. mig(ji) == jpisft(ib) )   ztestmask(2) = tmask(ji,jj,1)   
    14601454            END DO 
    14611455         END DO 
     
    14781472         DO ji = 1, jpi 
    14791473            DO jj = 1, jpj              
    1480               IF (((jj + njmpp - 1) == jpjnob(ib)+1).AND. &  
    1481                &  ((ji + nimpp - 1) == jpindt(ib))) ztestmask(1)=tmask(ji,jj,1) 
    1482               IF (((jj + njmpp - 1) == jpjnob(ib)+1).AND. &  
    1483                &  ((ji + nimpp - 1) == jpinft(ib))) ztestmask(2)=tmask(ji,jj,1)   
     1474               IF( mjg(jj) == jpjnob(ib)+1 .AND. mig(ji) == jpindt(ib) )   ztestmask(1) = tmask(ji,jj,1) 
     1475               IF( mjg(jj) == jpjnob(ib)+1 .AND. mig(ji) == jpinft(ib) )   ztestmask(2) = tmask(ji,jj,1)   
    14841476            END DO 
    14851477         END DO 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/lbc_nfd_generic.h90

    r13247 r13252  
    150150                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
    151151                     END DO 
    152                      !                            ! points jpiglo - nn_hls + 1 to jpiglo : have been / will done by e-w periodicity  
     152                     !                            ! last nn_hls-1 points: have been / will done by e-w periodicity  
    153153                  END DO 
    154154                  ! 
     
    195195                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
    196196                     END DO 
    197                      !                            ! points jpiglo - nn_hls + 1 to jpiglo : have been / will done by e-w periodicity  
     197                     !                            ! last nn_hls-1 points: have been / will done by e-w periodicity  
    198198                  END DO 
    199199                  ! 
     
    392392                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
    393393                     END DO 
    394                      !                            ! points jpiglo - nn_hls + 1 to jpiglo : have been / will done by e-w periodicity  
     394                     !                            ! last nn_hls points: have been / will done by e-w periodicity  
    395395                  END DO 
    396396                  ! 
     
    447447                        ARRAY_IN(ii1,ij1,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii2,ij2,jk,jl,jf) 
    448448                     END DO 
    449                      !                            ! points jpiglo - nn_hls + 1 to jpiglo : have been / will done by e-w periodicity  
     449                     !                            ! last nn_hls points: have been / will done by e-w periodicity  
    450450                  END DO 
    451451                  ! 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/mpp_nfd_generic.h90

    r13247 r13252  
    8585      LOGICAL  ::   ll_add_line 
    8686      INTEGER  ::   ji,  jj,  jk,  jl, jh, jf, jr   ! dummy loop indices 
    87       INTEGER  ::   ipi, ipk, ipl, ipf         ! dimension of the input array 
     87      INTEGER  ::   ipi, ipj, ipj2, ipk, ipl, ipf   ! dimension of the input array 
    8888      INTEGER  ::   imigr, iihom, ijhom             ! local integers 
    89       INTEGER  ::   ierr, ibuffsize, ijpi, iis0, iie0, iilb 
    90       INTEGER  ::   ijbs, ijbe, ipimax2 
     89      INTEGER  ::   ierr, ibuffsize, iis0, iie0, impp 
     90      INTEGER  ::   ii1, ii2, ij1, ij2 
     91      INTEGER  ::   ipimax, i0max 
    9192      INTEGER  ::   ij, iproc, ipni 
    9293      INTEGER, DIMENSION (jpmaxngh)       ::   ml_req_nf   ! for mpi_isend when avoiding mpi_allgather 
     
    9596      !                                                    ! Workspace for message transfers avoiding mpi_allgather 
    9697      INTEGER                             ::   ipj_b       ! sum of lines for all multi fields 
    97       INTEGER                             ::   ijs, ijb    ! j-counter for send and buffer 
    9898      INTEGER                             ::   i012        ! 0, 1 or 2 
    9999      INTEGER , DIMENSION(:,:)        , ALLOCATABLE ::   jj_s  ! position of sent lines 
     
    101101      INTEGER , DIMENSION(:)          , ALLOCATABLE ::   ipj_s ! number of sent lines 
    102102      REAL(PRECISION), DIMENSION(:,:,:,:)    , ALLOCATABLE ::   ztabb, ztabr, ztabw  ! buffer, receive and work arrays 
    103       REAL(PRECISION), DIMENSION(:,:,:,:,:)  , ALLOCATABLE ::   ztab, znorthloc 
    104       REAL(PRECISION), DIMENSION(:,:,:,:,:,:), ALLOCATABLE ::   znorthgloio 
     103      REAL(PRECISION), DIMENSION(:,:,:,:,:)  , ALLOCATABLE ::   ztabglo, znorthloc 
     104      REAL(PRECISION), DIMENSION(:,:,:,:,:,:), ALLOCATABLE ::   znorthglo 
    105105      !!---------------------------------------------------------------------- 
    106106      ! 
     
    145145         ENDIF 
    146146          
    147          ijpj  = MAXVAL(ipj_s(:))            ! Max 2nd dimension of message transfers (last two j-line only) 
     147         ipj   = MAXVAL(ipj_s(:))            ! Max 2nd dimension of message transfers 
    148148         ipj_b = SUM(   ipj_s(:))            ! Total number of lines to be exchanged 
    149          ALLOCATE( jj_s(ijpj, ipf), jj_b(ijpj, ipf) ) 
     149         ALLOCATE( jj_s(ipj, ipf), jj_b(ipj, ipf) ) 
    150150 
    151151         ! Index of modifying lines in input 
    152          ijb = 0 
     152         ij1 = 0 
    153153         DO jf = 1, ipf                      ! Loop over the number of arrays to be processed 
    154154            ! 
     
    167167               ! 
    168168            DO jj = 1, ipj_s(jf) 
    169                ijb = ijb + 1 
    170                jj_b(jj,jf) = ijb 
     169               ij1 = ij1 + 1 
     170               jj_b(jj,jf) = ij1 
    171171               jj_s(jj,jf) = jpj - 2*nn_hls + jj - i012 
    172172            END DO 
     
    179179         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk 
    180180            DO jj = 1, ipj_s(jf) 
    181                ijb = jj_b(jj,jf) 
    182                ijs = jj_s(jj,jf) 
    183                ztabb(    1:jpi   ,ijb,jk,jl) = ARRAY_IN(1:jpi,ijs,jk,jl,jf) 
    184                ztabb(jpi+1:jpimax,ijb,jk,jl) = 0._wp  ! needed? to avoid sending uninitialized values 
     181               ij1 = jj_b(jj,jf) 
     182               ij2 = jj_s(jj,jf) 
     183               DO ji = 1, jpi 
     184                  ztabb(ji,ij1,jk,jl) = ARRAY_IN(ji,ij2,jk,jl,jf) 
     185               END DO 
     186               DO ji = jpi+1, jpimax 
     187                  ztabb(ji,ij1,jk,jl) = HUGE(0._wp)   ! avoid sending uninitialized values (make sure we don't use it) 
     188               END DO 
    185189            END DO 
    186190         END DO   ;   END DO   ;   END DO 
     
    197201         END DO 
    198202         ! 
    199          ipimax2 = jpimax * jpmaxngh 
    200          ALLOCATE( ztabw(jpimax,ipj_b,ipk,ipl), ztabr(ipimax2,ipj_b,ipk,ipl) )  
     203         ipimax = jpimax * jpmaxngh 
     204         ALLOCATE( ztabw(jpimax,ipj_b,ipk,ipl), ztabr(ipimax,ipj_b,ipk,ipl) )  
    201205         ! 
    202206         DO jr = 1, nsndto 
     
    204208            ipni  = isendto(jr) 
    205209            iproc = nfproc(ipni) 
    206             ijpi  = nfjpi (ipni) 
    207             ! 
    208             IF( ipni ==   1  ) THEN   ;   iis0 =   1             ! domain  left side: as e-w comm already done -> from 1st column 
    209             ELSE                      ;   iis0 =   1  + nn_hls   ! default: -> from inner domain  
    210             ENDIF 
    211             IF( ipni == jpni ) THEN   ;   iie0 = ijpi            ! domain right side: as e-w comm already done -> until last column 
    212             ELSE                      ;   iie0 = ijpi - nn_hls   ! default: -> until inner domain  
    213             ENDIF 
    214             iilb = nfimpp(ipni) - nfimpp(isendto(1)) 
     210            ipi   = nfjpi (ipni) 
     211            ! 
     212            IF( ipni ==   1  ) THEN   ;   iis0 =   1            ! domain  left side: as e-w comm already done -> from 1st column 
     213            ELSE                      ;   iis0 =   1 + nn_hls   ! default: -> from inner domain  
     214            ENDIF 
     215            IF( ipni == jpni ) THEN   ;   iie0 = ipi            ! domain right side: as e-w comm already done -> until last column 
     216            ELSE                      ;   iie0 = ipi - nn_hls   ! default: -> until inner domain  
     217            ENDIF 
     218            impp = nfimpp(ipni) - nfimpp(isendto(1)) 
    215219            ! 
    216220            IF(           iproc == -1 ) THEN   ! No neighbour (land proc that was suppressed) 
     
    221225                  DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk 
    222226                     DO jj = 1, ipj_s(jf) 
    223                         ijb = jj_b(jj,jf) 
    224                         ijs = jj_s(jj,jf) 
     227                        ij1 = jj_b(jj,jf) 
     228                        ij2 = jj_s(jj,jf) 
    225229                        DO ji = iis0, iie0 
    226                            ztabr(iilb+ji,ijb,jk,jl) = ARRAY_IN(nn_hls+1,ijs,jk,jl,jf)   ! chose to take the 1st iner domain point 
     230                           ztabr(impp+ji,ij1,jk,jl) = ARRAY_IN(Nis0,ij2,jk,jl,jf)   ! chose to take the 1st iner domain point 
    227231                        END DO 
    228232                     END DO 
     
    232236                     DO jj = 1, ipj_b 
    233237                        DO ji = iis0, iie0 
    234                            ztabr(iilb+ji,jj,jk,jl) = pfillval 
     238                           ztabr(impp+ji,jj,jk,jl) = pfillval 
    235239                        END DO 
    236240                     END DO 
     
    242246               DO jf = 1, ipf   ;   DO jl = 1, ipl  ;   DO jk = 1, ipk 
    243247                  DO jj = 1, ipj_s(jf) 
    244                      ijb = jj_b(jj,jf) 
    245                      ijs = jj_s(jj,jf) 
     248                     ij1 = jj_b(jj,jf) 
     249                     ij2 = jj_s(jj,jf) 
    246250                     DO ji = iis0, iie0 
    247                         ztabr(iilb+ji,ijb,jk,jl) = ARRAY_IN(ji,ijs,jk,jl,jf) 
     251                        ztabr(impp+ji,ij1,jk,jl) = ARRAY_IN(ji,ij2,jk,jl,jf) 
    248252                     END DO 
    249253                  END DO 
     
    256260                  DO jj = 1, ipj_b 
    257261                     DO ji = iis0, iie0 
    258                         ztabr(iilb+ji,jj,jk,jl) = ztabw(ji,jj,jk,jl) 
     262                        ztabr(impp+ji,jj,jk,jl) = ztabw(ji,jj,jk,jl) 
    259263                     END DO 
    260264                  END DO 
     
    262266                
    263267            ENDIF 
    264          END DO 
     268            ! 
     269         END DO   ! nsndto 
    265270         ! 
    266271         IF( ln_timing ) CALL tic_tac(.FALSE.) 
     
    269274         ! 
    270275         DO jf = 1, ipf 
    271             ijbs = jj_b(       1 ,jf) 
    272             ijbe = jj_b(ipj_s(jf),jf) 
    273             CALL lbc_nfd_nogather( ARRAY_IN(:,:,:,:,jf), ztabr(:,ijbs:ijbe,:,:), cd_nat LBC_ARG, psgn LBC_ARG ) 
     276            ij1 = jj_b(       1 ,jf) 
     277            ij2 = jj_b(ipj_s(jf),jf) 
     278            CALL lbc_nfd_nogather( ARRAY_IN(:,:,:,:,jf), ztabr(:,ij1:ij2,:,:), cd_nat LBC_ARG, psgn LBC_ARG ) 
    274279         END DO 
    275280         ! 
     
    286291      ELSE                             !==  allgather exchanges  ==! 
    287292         ! 
    288          ijpj   = 4            ! 2nd dimension of message transfers (last j-lines) 
    289          ! 
    290          ALLOCATE( znorthloc(jpimax,ijpj,ipk,ipl,ipf) ) 
    291          ! 
    292          DO jf = 1, ipf                ! put in znorthloc the last ijpj j-lines of ptab 
    293             DO jl = 1, ipl 
    294                DO jk = 1, ipk 
    295                   DO jj = jpj - ijpj +1, jpj 
    296                      ij = jj - jpj + ijpj 
    297                      znorthloc(1:jpi,ij,jk,jl,jf) = ARRAY_IN(1:jpi,jj,jk,jl,jf) 
    298                   END DO 
     293         ! how many lines do we exchange at max? -> ipj    (no further optimizations in this case...) 
     294         ipj =      nn_hls + 2 
     295         ! how many lines do we     need at max? -> ipj2   (no further optimizations in this case...) 
     296         ipj2 = 2 * nn_hls + 2 
     297         ! 
     298         i0max = jpimax - 2 * nn_hls 
     299         ibuffsize = i0max * ipj * ipk * ipl * ipf 
     300         ALLOCATE( znorthloc(i0max,ipj,ipk,ipl,ipf), znorthglo(i0max,ipj,ipk,ipl,ipf,jpni) ) 
     301         ! 
     302         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk               ! put in znorthloc ipj j-lines of ptab 
     303            DO jj = 1, ipj 
     304               ij2 = jpj - ipj2 + jj                        ! the first ipj lines of the last ipj2 lines 
     305               DO ji = 1, Ni_0 
     306                  ii2 = Nis0 - 1 + ji                       ! inner domain: Nis0 to Nie0 
     307                  znorthloc(ji,jj,jk,jl,jf) = ARRAY_IN(ii2,ij2,jk,jl,jf) 
     308               END DO 
     309               DO ji = Nie0+1, i0max 
     310                  znorthloc(ji,jj,jk,jl,jf) = HUGE(0._wp)   ! avoid sending uninitialized values (make sure we don't use it) 
    299311               END DO 
    300312            END DO 
    301          END DO 
    302          ! 
    303          ibuffsize = jpimax * ijpj * ipk * ipl * ipf 
    304          ! 
    305          ALLOCATE( ztab       (jpiglo,ijpj,ipk,ipl,ipf     ) ) 
    306          ALLOCATE( znorthgloio(jpimax,ijpj,ipk,ipl,ipf,jpni) ) 
    307          ! 
    308          ! when some processors of the north fold are suppressed, 
    309          ! values of ztab* arrays corresponding to these suppressed domain won't be defined 
    310          ! and we need a default definition to 0. 
    311          ! a better test should be: a testing if "suppressed land-processors" belongs to the north-pole folding 
    312          IF ( jpni*jpnj /= jpnij ) ztab(:,:,:,:,:) = 0._wp 
     313         END DO   ;   END DO   ;   END DO 
    313314         ! 
    314315         ! start waiting time measurement 
    315316         IF( ln_timing ) CALL tic_tac(.TRUE.) 
    316          CALL MPI_ALLGATHER( znorthloc  , ibuffsize, MPI_TYPE,                & 
    317             &                znorthgloio, ibuffsize, MPI_TYPE, ncomm_north, ierr ) 
    318          ! 
     317         CALL MPI_ALLGATHER( znorthloc, ibuffsize, MPI_TYPE, znorthglo, ibuffsize, MPI_TYPE, ncomm_north, ierr ) 
    319318         ! stop waiting time measurement 
    320319         IF( ln_timing ) CALL tic_tac(.FALSE.) 
    321          ! 
    322          DO jr = 1, ndim_rank_north         ! recover the global north array 
    323             iproc = nrank_north(jr) + 1 
    324             iilb  =  nimppt(iproc) 
    325             ijpi  =  jpiall(iproc) 
    326             iis0  = nis0all(iproc) 
    327             iie0  = nie0all(iproc) 
    328             IF( iilb            ==      1 )   iis0 = 1      ! e-w boundary already done -> force to take all from 1st column 
    329             IF( iilb + ijpi - 1 == jpiglo )   iie0 = ijpi   ! e-w boundary already done -> force to take all until last column 
    330             DO jf = 1, ipf 
    331                DO jl = 1, ipl 
    332                   DO jk = 1, ipk 
    333                      DO jj = 1, ijpj 
    334                         DO ji = iis0, iie0 
    335                            ztab(ji+iilb-1,jj,jk,jl,jf) = znorthgloio(ji,jj,jk,jl,jf,jr) 
     320         DEALLOCATE( znorthloc ) 
     321         ALLOCATE( ztabglo(jpiglo,ipj2,ipk,ipl,ipf) ) 
     322         ! 
     323         ! need to fill only the first ipj lines of ztabglo as lbc_nfd don't use the last nn_hls lines 
     324         DO jr = 1, jpni                                                        ! recover the global north array 
     325            iproc = nfproc(jr) 
     326            impp  = nfimpp(jr) 
     327            ipi   = nfjpi( jr) - 2 * nn_hls                       ! corresponds to Ni_0 but for subdomain iproc 
     328            IF( iproc == -1 ) THEN   ! No neighbour (land proc that was suppressed) 
     329              ! 
     330               SELECT CASE ( kfillmode ) 
     331               CASE ( jpfillnothing )               ! no filling  
     332               CASE ( jpfillcopy    )               ! filling with inner domain values 
     333                  DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk 
     334                     DO jj = 1, ipj 
     335                        ij2 = jpj - ipj2 + jj                    ! the first ipj lines of the last ipj2 lines 
     336                        DO ji = 1, ipi 
     337                           ii1 = impp + nn_hls + ji - 1          ! corresponds to mig(nn_hls + ji) but for subdomain iproc 
     338                           ztabglo(ii1,jj,jk,jl,jf) = ARRAY_IN(Nis0,ij2,jk,jl,jf)   ! chose to take the 1st iner domain point 
    336339                        END DO 
    337340                     END DO 
     341                  END DO   ;   END DO   ;   END DO 
     342               CASE ( jpfillcst     )               ! filling with constant value 
     343                  DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk 
     344                     DO jj = 1, ipj 
     345                        DO ji = 1, ipi 
     346                           ii1 = impp + nn_hls + ji - 1          ! corresponds to mig(nn_hls + ji) but for subdomain iproc 
     347                           ztabglo(ii1,jj,jk,jl,jf) = pfillval 
     348                        END DO 
     349                     END DO 
     350                 END DO   ;   END DO   ;   END DO 
     351               END SELECT 
     352               ! 
     353            ELSE 
     354               DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk 
     355                  DO jj = 1, ipj 
     356                     DO ji = 1, ipi 
     357                        ii1 = impp + nn_hls + ji - 1             ! corresponds to mig(nn_hls + ji) but for subdomain iproc 
     358                        ztabglo(ii1,jj,jk,jl,jf) = znorthglo(ji,jj,jk,jl,jf,jr) 
     359                     END DO 
    338360                  END DO 
     361               END DO   ;   END DO   ;   END DO 
     362            ENDIF 
     363            ! 
     364         END DO   ! jpni 
     365         DEALLOCATE( znorthglo ) 
     366         ! 
     367         DO jf = 1, ipf 
     368            CALL lbc_nfd( ztabglo(:,:,:,:,jf), cd_nat LBC_ARG, psgn LBC_ARG )   ! North fold boundary condition 
     369            DO jl = 1, ipl   ;   DO jk = 1, ipk                  ! e-w periodicity 
     370               DO jj = 1, nn_hls + 1 
     371                  ij1 = ipj2 - (nn_hls + 1) + jj                 ! need only the last nn_hls + 1 lines until ipj2 
     372                  ztabglo(              1:nn_hls,ij1,jk,jl,jf) = ztabglo(jpiglo-2*nn_hls+1:jpiglo-nn_hls,ij1,jk,jl,jf) 
     373                  ztabglo(jpiglo-nn_hls+1:jpiglo,ij1,jk,jl,jf) = ztabglo(         nn_hls+1:     2*nn_hls,ij1,jk,jl,jf) 
     374               END DO 
     375            END DO   ;   END DO 
     376         END DO      
     377         ! 
     378         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk               ! Scatter back to ARRAY_IN 
     379            DO jj = 1, nn_hls + 1 
     380               ij1 = jpj  - (nn_hls + 1) + jj   ! last nn_hls + 1 lines until jpj 
     381               ij2 = ipj2 - (nn_hls + 1) + jj   ! last nn_hls + 1 lines until ipj2 
     382               DO ji= 1, jpi 
     383                  ii2 = mig(ji) 
     384                  ARRAY_IN(ji,ij1,jk,jl,jf) = ztabglo(ii2,ij2,jk,jl,jf) 
    339385               END DO 
    340386            END DO 
    341          END DO 
    342          DO jf = 1, ipf 
    343             CALL lbc_nfd( ztab(:,:,:,:,jf), cd_nat LBC_ARG, psgn LBC_ARG )   ! North fold boundary condition 
    344          END DO 
    345          ! 
    346          DO jf = 1, ipf 
    347             DO jl = 1, ipl 
    348                DO jk = 1, ipk 
    349                   DO jj = jpj-ijpj+1, jpj             ! Scatter back to ARRAY_IN 
    350                      ij = jj - jpj + ijpj 
    351                      DO ji= 1, jpi 
    352                         ARRAY_IN(ji,jj,jk,jl,jf) = ztab(ji+nimpp-1,ij,jk,jl,jf) 
    353                      END DO 
    354                   END DO 
    355                END DO 
    356             END DO 
    357          END DO 
    358          ! 
    359       ! 
    360          DEALLOCATE( ztab, znorthgloio, znorthloc ) 
    361       ENDIF 
     387         END DO   ;   END DO   ;   END DO 
     388         ! 
     389         DEALLOCATE( ztabglo ) 
     390         ! 
     391      ENDIF   ! l_north_nogather 
    362392      ! 
    363393   END SUBROUTINE ROUTINE_NFD 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/nemogcm.F90

    r13248 r13252  
    4747   USE usrdef_nam     ! user defined configuration 
    4848   USE tide_mod, ONLY : tide_init ! tidal components initialization   (tide_init routine) 
    49    USE bdy_oce,  ONLY : ln_bdy 
    5049   USE bdyini         ! open boundary cond. setting       (bdy_init routine) 
    5150   USE istate         ! initial state setting          (istate_init routine) 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OFF/nemogcm.F90

    r13248 r13252  
    3131   USE domqco         ! tools for scale factor         (dom_qco_r3c  routine) 
    3232#endif 
    33    USE bdy_oce,  ONLY : ln_bdy 
    34    USE bdyini         ! open boundary cond. setting       (bdy_init routine) 
     33   USE bdyini         ! open boundary cond. setting        (bdy_init routine) 
    3534   !              ! ocean physics 
    3635   USE ldftra         ! lateral diffusivity setting    (ldf_tra_init routine) 
Note: See TracChangeset for help on using the changeset viewer.