Changeset 4671


Ignore:
Timestamp:
2014-06-17T17:00:51+02:00 (6 years ago)
Author:
epico
Message:

bug fix in north fold optimization when land-processes are removed. see ticket #1195

Location:
trunk/NEMOGCM/NEMO/OPA_SRC
Files:
6 edited

Legend:

Unmodified
Added
Removed
  • trunk/NEMOGCM/NEMO/OPA_SRC/DOM/dom_oce.F90

    r4488 r4671  
    153153   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nldit , nldjt    !: first, last indoor index for each i-domain 
    154154   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:) ::   nleit , nlejt    !: first, last indoor index for each j-domain 
     155   INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: nfiimpp, nfipproc, nfilcit 
    155156 
    156157   !!---------------------------------------------------------------------- 
     
    329330      ierr(:) = 0 
    330331      ! 
    331       ALLOCATE( rdttra(jpk), r2dtra(jpk), mig(jpi), mjg(jpj), STAT=ierr(1) ) 
     332      ALLOCATE( rdttra(jpk), r2dtra(jpk), mig(jpi), mjg(jpj), nfiimpp(jpni,jpnj),  & 
     333         &      nfipproc(jpni,jpnj), nfilcit(jpni,jpnj), STAT=ierr(1) ) 
    332334         ! 
    333335      ALLOCATE( nimppt(jpnij) , ibonit(jpnij) , nlcit(jpnij) , nlcjt(jpnij) ,     & 
  • trunk/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90

    r4230 r4671  
    3333 
    3434   INTEGER, PUBLIC,  PARAMETER :: jpmaxngh = 3 
    35    INTEGER, PUBLIC                                  ::   nsndto 
     35   INTEGER, PUBLIC                                  ::   nsndto, nfsloop, nfeloop 
    3636   INTEGER, PUBLIC,  DIMENSION (jpmaxngh)           ::   isendto ! processes to which communicate 
    3737 
     
    412412            SELECT CASE ( cd_type ) 
    413413            CASE ( 'T' , 'W' )                         ! T-, W-point 
    414                IF (narea .ne. (jpnij - jpni + 1)) THEN 
     414               IF (nimpp .ne. 1) THEN 
    415415                 startloop = 1 
    416416               ELSE 
     
    420420               DO jk = 1, jpk 
    421421                  DO ji = startloop, nlci 
    422                      ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 4 
     422                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    423423                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-2,jk) 
    424424                  END DO 
     
    435435                 DO jk = 1, jpk 
    436436                    DO ji = startloop, nlci 
    437                        ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 4 
     437                       ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    438438                       jia = ji + nimpp - 1 
    439439                       ijta = jpiglo - jia + 2 
     
    448448 
    449449 
    450  
    451450            CASE ( 'U' )                               ! U-point 
    452                IF (narea .ne. (jpnij)) THEN 
     451               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    453452                  endloop = nlci 
    454453               ELSE 
     
    457456               DO jk = 1, jpk 
    458457                  DO ji = 1, endloop 
    459                      iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     458                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    460459                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(iju,ijpj-2,jk) 
    461460                  END DO 
    462461               END DO 
    463462 
    464                IF (narea .ne. (jpnij)) THEN 
     463               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    465464                  endloop = nlci 
    466465               ELSE 
     
    477476                 DO jk = 1, jpk 
    478477                    DO ji = startloop, endloop 
    479                       iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     478                      iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    480479                      jia = ji + nimpp - 1 
    481480                      ijua = jpiglo - jia + 1 
     
    490489 
    491490            CASE ( 'V' )                               ! V-point 
    492                IF (narea .ne. (jpnij - jpni + 1)) THEN 
     491               IF (nimpp .ne. 1) THEN 
    493492                  startloop = 1 
    494493               ELSE 
     
    497496               DO jk = 1, jpk 
    498497                  DO ji = startloop, nlci 
    499                      ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 4 
     498                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    500499                     pt3dl(ji,ijpj-1,jk) = psgn * pt3dr(ijt,ijpj-2,jk) 
    501500                     pt3dl(ji,ijpj  ,jk) = psgn * pt3dr(ijt,ijpj-3,jk) 
     
    503502               END DO 
    504503            CASE ( 'F' )                               ! F-point 
    505                IF (narea .ne. (jpnij)) THEN 
     504               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    506505                  endloop = nlci 
    507506               ELSE 
     
    510509               DO jk = 1, jpk 
    511510                  DO ji = 1, endloop 
    512                      iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     511                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    513512                     pt3dl(ji,ijpj-1,jk) = psgn * pt3dr(iju,ijpj-2,jk) 
    514513                     pt3dl(ji,ijpj  ,jk) = psgn * pt3dr(iju,ijpj-3,jk) 
     
    524523               DO jk = 1, jpk 
    525524                  DO ji = 1, nlci 
    526                      ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     525                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    527526                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-1,jk) 
    528527                  END DO 
     
    530529 
    531530            CASE ( 'U' )                               ! U-point 
    532                IF (narea .ne. (jpnij)) THEN 
     531               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    533532                  endloop = nlci 
    534533               ELSE 
     
    537536               DO jk = 1, jpk 
    538537                  DO ji = 1, endloop 
    539                      iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 2 
     538                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
    540539                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(iju,ijpj-1,jk) 
    541540                  END DO 
     
    545544               DO jk = 1, jpk 
    546545                  DO ji = 1, nlci 
    547                      ijt = jpiglo - ji- nimpp - nimppt(isendto(1)) + 3 
     546                     ijt = jpiglo - ji- nimpp - nfiimpp(isendto(1),jpnj) + 3 
    548547                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-2,jk) 
    549548                  END DO 
     
    560559                 DO jk = 1, jpk 
    561560                    DO ji = startloop, nlci 
    562                        ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     561                       ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    563562                       pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(ijt,ijpjm1,jk) 
    564563                    END DO 
     
    567566 
    568567            CASE ( 'F' )                               ! F-point 
    569                IF (narea .ne. (jpnij)) THEN 
     568               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    570569                  endloop = nlci 
    571570               ELSE 
     
    574573               DO jk = 1, jpk 
    575574                  DO ji = 1, endloop 
    576                      iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 2 
     575                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
    577576                     pt3dl(ji,ijpj ,jk) = psgn * pt3dr(iju,ijpj-2,jk) 
    578577                  END DO 
    579578               END DO 
    580579 
    581                IF (narea .ne. (jpnij)) THEN 
     580               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    582581                  endloop = nlci 
    583582               ELSE 
     
    594593                  DO jk = 1, jpk 
    595594                     DO ji = startloop, endloop 
    596                         iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 2 
     595                        iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
    597596                        pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(iju,ijpjm1,jk) 
    598597                     END DO 
     
    656655         ! 
    657656         CASE ( 'T' , 'W' )                               ! T- , W-points 
    658             IF (narea .ne. (jpnij - jpni + 1)) THEN 
     657            IF (nimpp .ne. 1) THEN 
    659658              startloop = 1 
    660659            ELSE 
     
    662661            ENDIF 
    663662            DO ji = startloop, nlci 
    664               ijt=jpiglo - ji - nimpp - nimppt(isendto(1)) + 4 
     663              ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    665664              pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-1) 
    666665            END DO 
     
    674673            ENDIF 
    675674            DO ji = startloop, nlci 
    676                ijt=jpiglo - ji - nimpp - nimppt(isendto(1)) + 4 
     675               ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    677676               jia = ji + nimpp - 1 
    678677               ijta = jpiglo - jia + 2 
     
    685684 
    686685         CASE ( 'U' )                                     ! U-point 
    687             IF (narea .ne. (jpnij)) THEN 
     686            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    688687               endloop = nlci 
    689688            ELSE 
     
    691690            ENDIF 
    692691            DO ji = 1, endloop 
    693                iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     692               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    694693               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-1) 
    695694            END DO 
    696695 
    697             IF (narea .ne. (jpnij)) THEN 
     696            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    698697               endloop = nlci 
    699698            ELSE 
     
    708707            ENDIF 
    709708            DO ji = startloop, endloop 
    710                iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     709               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    711710               jia = ji + nimpp - 1 
    712711               ijua = jpiglo - jia + 1 
     
    719718 
    720719         CASE ( 'V' )                                     ! V-point 
    721             IF (narea .ne. (jpnij - jpni + 1)) THEN 
     720            IF (nimpp .ne. 1) THEN 
    722721              startloop = 1 
    723722            ELSE 
     
    725724            ENDIF 
    726725            DO ji = startloop, nlci 
    727               ijt=jpiglo - ji - nimpp - nimppt(isendto(1)) + 4 
     726              ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    728727              pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1-1) 
    729728              pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-2) 
     
    731730 
    732731         CASE ( 'F' )                                     ! F-point 
    733             IF (narea .ne. (jpnij)) THEN 
     732            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    734733               endloop = nlci 
    735734            ELSE 
     
    737736            ENDIF 
    738737            DO ji = 1, endloop 
    739                iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     738               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    740739               pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1-1) 
    741740               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-2) 
     
    743742 
    744743         CASE ( 'I' )                                     ! ice U-V point (I-point) 
    745             IF (narea .ne. (jpnij - jpni + 1)) THEN 
     744            IF (nimpp .ne. 1) THEN 
    746745               startloop = 1 
    747746            ELSE 
     
    750749            ENDIF 
    751750            DO ji = startloop, nlci 
    752                iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 5 
     751               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5 
    753752               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1) 
    754753            END DO 
    755754 
    756755         CASE ( 'J' )                                     ! first ice U-V point 
    757             IF (narea .ne. (jpnij - jpni + 1)) THEN 
     756            IF (nimpp .ne. 1) THEN 
    758757               startloop = 1 
    759758            ELSE 
     
    762761            ENDIF 
    763762            DO ji = startloop, nlci 
    764                iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 5 
     763               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5 
    765764               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1) 
    766765            END DO 
    767766 
    768767         CASE ( 'K' )                                     ! second ice U-V point 
    769             IF (narea .ne. (jpnij - jpni + 1)) THEN 
     768            IF (nimpp .ne. 1) THEN 
    770769               startloop = 1 
    771770            ELSE 
     
    774773            ENDIF 
    775774            DO ji = startloop, nlci 
    776                iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 5 
     775               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5 
    777776               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1) 
    778777            END DO 
     
    785784         CASE ( 'T' , 'W' )                               ! T-, W-point 
    786785            DO ji = 1, nlci 
    787                ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     786               ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    788787               pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1) 
    789788            END DO 
    790789 
    791790         CASE ( 'U' )                                     ! U-point 
    792             IF (narea .ne. (jpnij)) THEN 
     791            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    793792               endloop = nlci 
    794793            ELSE 
     
    796795            ENDIF 
    797796            DO ji = 1, endloop 
    798                iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 2 
     797               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
    799798               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1) 
    800799            END DO 
     
    802801         CASE ( 'V' )                                     ! V-point 
    803802            DO ji = 1, nlci 
    804                ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     803               ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    805804               pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-1) 
    806805            END DO 
     
    813812            ENDIF 
    814813            DO ji = startloop, nlci 
    815                ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     814               ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    816815               pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1) 
    817816            END DO 
    818817 
    819818         CASE ( 'F' )                               ! F-point 
    820             IF (narea .ne. (jpnij)) THEN 
     819            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    821820               endloop = nlci 
    822821            ELSE 
     
    824823            ENDIF 
    825824            DO ji = 1, endloop 
    826                iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 2 
     825               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
    827826               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-1) 
    828827            END DO 
    829828 
    830             IF (narea .ne. (jpnij)) THEN 
     829            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    831830               endloop = nlci 
    832831            ELSE 
     
    842841 
    843842            DO ji = startloop, endloop 
    844                iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 2 
     843               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
    845844               pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1) 
    846845            END DO 
    847846 
    848847         CASE ( 'I' )                                  ! ice U-V point (I-point) 
    849                IF (narea .ne. (jpnij - jpni + 1)) THEN 
     848               IF (nimpp .ne. 1) THEN 
    850849                  startloop = 1 
    851850               ELSE 
    852851                  startloop = 2 
    853852               ENDIF 
    854                IF (narea .ne. jpnij) THEN 
     853               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    855854                  endloop = nlci 
    856855               ELSE 
     
    858857               ENDIF 
    859858               DO ji = startloop , endloop 
    860                   ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 4 
     859                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    861860                  pt2dl(ji,ijpj)= 0.5 * (pt2dr(ji,ijpjm1) + psgn * pt2dr(ijt,ijpjm1)) 
    862861               END DO 
    863862 
    864863         CASE ( 'J' )                                  ! first ice U-V point 
    865                IF (narea .ne. (jpnij - jpni + 1)) THEN 
     864               IF (nimpp .ne. 1) THEN 
    866865                  startloop = 1 
    867866               ELSE 
    868867                  startloop = 2 
    869868               ENDIF 
    870                IF (narea .ne. jpnij) THEN 
     869               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    871870                  endloop = nlci 
    872871               ELSE 
     
    874873               ENDIF 
    875874               DO ji = startloop , endloop 
    876                   ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 4 
     875                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    877876                  pt2dl(ji,ijpj) = pt2dr(ji,ijpjm1) 
    878877               END DO 
    879878 
    880879         CASE ( 'K' )                                  ! second ice U-V point 
    881                IF (narea .ne. (jpnij - jpni + 1)) THEN 
     880               IF (nimpp .ne. 1) THEN 
    882881                  startloop = 1 
    883882               ELSE 
    884883                  startloop = 2 
    885884               ENDIF 
    886                IF (narea .ne. jpnij) THEN 
     885               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    887886                  endloop = nlci 
    888887               ELSE 
     
    890889               ENDIF 
    891890               DO ji = startloop, endloop 
    892                   ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 4 
     891                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    893892                  pt2dl(ji,ijpj) = pt2dr(ijt,ijpjm1) 
    894893               END DO 
  • trunk/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r4645 r4671  
    20262026      ijpjm1 = 3 
    20272027      ! 
     2028      znorthloc(:,:,:) = 0 
    20282029      DO jk = 1, jpk 
    20292030         DO jj = nlcj - ijpj +1, nlcj          ! put in xnorthloc the last 4 jlines of pt3d 
     
    20362037      itaille = jpi * jpk * ijpj 
    20372038 
    2038  
    20392039      IF ( l_north_nogather ) THEN 
    20402040         ! 
    20412041        ztabr(:,:,:) = 0 
     2042        ztabl(:,:,:) = 0 
     2043 
    20422044        DO jk = 1, jpk 
    20432045           DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array 
    20442046              ij = jj - nlcj + ijpj 
    2045               DO ji = 1, nlci 
     2047              DO ji = nfsloop, nfeloop 
    20462048                 ztabl(ji,ij,jk) = pt3d(ji,jj,jk) 
    20472049              END DO 
     
    20502052 
    20512053         DO jr = 1,nsndto 
    2052             IF (isendto(jr) .ne. narea) CALL mppsend( 5, znorthloc, itaille, isendto(jr)-1, ml_req_nf(jr) ) 
     2054            IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 
     2055              CALL mppsend( 5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr) ) 
     2056            ENDIF 
    20532057         END DO 
    20542058         DO jr = 1,nsndto 
    2055             iproc = isendto(jr) 
    2056             ildi = nldit (iproc) 
    2057             ilei = nleit (iproc) 
    2058             iilb = nimppt(isendto(jr)) - nimppt(isendto(1)) 
    2059             IF(isendto(jr) .ne. narea) THEN 
    2060               CALL mpprecv(5, zfoldwk, itaille, isendto(jr)-1) 
     2059            iproc = nfipproc(isendto(jr),jpnj) 
     2060            IF(iproc .ne. -1) THEN 
     2061               ilei = nleit (iproc+1) 
     2062               ildi = nldit (iproc+1) 
     2063               iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj) 
     2064            ENDIF 
     2065            IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN 
     2066              CALL mpprecv(5, zfoldwk, itaille, iproc) 
    20612067              DO jk = 1, jpk 
    20622068                 DO jj = 1, ijpj 
    2063                     DO ji = 1, ilei 
     2069                    DO ji = ildi, ilei 
    20642070                       ztabr(iilb+ji,jj,jk) = zfoldwk(ji,jj,jk) 
    20652071                    END DO 
    20662072                 END DO 
    20672073              END DO 
    2068            ELSE 
     2074           ELSE IF (iproc .eq. (narea-1)) THEN 
    20692075              DO jk = 1, jpk 
    20702076                 DO jj = 1, ijpj 
    2071                     DO ji = 1, ilei 
     2077                    DO ji = ildi, ilei 
    20722078                       ztabr(iilb+ji,jj,jk) = pt3d(ji,nlcj-ijpj+jj,jk) 
    20732079                    END DO 
     
    20782084         IF (l_isend) THEN 
    20792085            DO jr = 1,nsndto 
    2080                IF (isendto(jr) .ne. narea) CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 
     2086               IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 
    20812087            END DO 
    20822088         ENDIF 
    20832089         CALL mpp_lbc_nfd( ztabl, ztabr, cd_type, psgn )   ! North fold boundary condition 
    2084          ! 
    20852090         DO jk = 1, jpk 
    20862091            DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt3d 
     
    21902195         ! 
    21912196         ztabr(:,:) = 0 
     2197         ztabl(:,:) = 0 
     2198 
    21922199         DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array 
    21932200            ij = jj - nlcj + ijpj 
    2194             DO ji = 1, nlci 
     2201              DO ji = nfsloop, nfeloop 
    21952202               ztabl(ji,ij) = pt2d(ji,jj) 
    21962203            END DO 
     
    21982205 
    21992206         DO jr = 1,nsndto 
    2200             IF (isendto(jr) .ne. narea) CALL mppsend(5, znorthloc, itaille, isendto(jr)-1, ml_req_nf(jr)) 
     2207            IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 
     2208               CALL mppsend(5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr)) 
     2209            ENDIF 
    22012210         END DO 
    22022211         DO jr = 1,nsndto 
    2203             iproc = isendto(jr) 
    2204             ildi = nldit (iproc) 
    2205             ilei = nleit (iproc) 
    2206             iilb = nimppt(isendto(jr)) - nimppt(isendto(1)) 
    2207             IF(isendto(jr) .ne. narea) THEN 
    2208               CALL mpprecv(5, zfoldwk, itaille, isendto(jr)-1) 
     2212            iproc = nfipproc(isendto(jr),jpnj) 
     2213            IF(iproc .ne. -1) THEN 
     2214               ilei = nleit (iproc+1) 
     2215               ildi = nldit (iproc+1) 
     2216               iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj) 
     2217            ENDIF 
     2218            IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN 
     2219              CALL mpprecv(5, zfoldwk, itaille, iproc) 
    22092220              DO jj = 1, ijpj 
    2210                  DO ji = 1, ilei 
     2221                 DO ji = ildi, ilei 
    22112222                    ztabr(iilb+ji,jj) = zfoldwk(ji,jj) 
    22122223                 END DO 
    22132224              END DO 
    2214             ELSE 
     2225            ELSE IF (iproc .eq. (narea-1)) THEN 
    22152226              DO jj = 1, ijpj 
    2216                  DO ji = 1, ilei 
     2227                 DO ji = ildi, ilei 
    22172228                    ztabr(iilb+ji,jj) = pt2d(ji,nlcj-ijpj+jj) 
    22182229                 END DO 
     
    22222233         IF (l_isend) THEN 
    22232234            DO jr = 1,nsndto 
    2224                IF (isendto(jr) .ne. narea) CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 
     2235               IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 
     2236                  CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 
     2237               ENDIF 
    22252238            END DO 
    22262239         ENDIF 
  • trunk/NEMOGCM/NEMO/OPA_SRC/LBC/mppini.F90

    r3294 r4671  
    177177       
    178178#endif 
     179      nfilcit(:,:) = ilcit(:,:) 
    179180      IF( irestj == 0 )   irestj = jpnj 
    180181 
     
    255256         END DO 
    256257      ENDIF 
     258      nfiimpp(:,:)=iimppt(:,:) 
    257259 
    258260      IF( jpnj > 1 ) THEN 
  • trunk/NEMOGCM/NEMO/OPA_SRC/LBC/mppini_2.h90

    r4647 r4671  
    144144#endif 
    145145 
     146      nfilcit(:,:) = ilci(:,:) 
     147 
    146148      IF(lwp) WRITE(numout,*) 
    147149      IF(lwp) WRITE(numout,*) ' mpp_init2: defines mpp subdomains' 
     
    175177         END DO 
    176178      ENDIF 
     179      nfiimpp(:,:) = iimppt(:,:) 
    177180 
    178181      IF( jpnj > 1 )THEN 
     
    195198         ili = ilci(ii,ij) 
    196199         ilj = ilcj(ii,ij) 
    197  
    198200         ibondj(ii,ij) = -1 
    199201         IF( jarea >  jpni          )   ibondj(ii,ij) = 0 
    200202         IF( jarea >  (jpnj-1)*jpni )   ibondj(ii,ij) = 1 
    201203         IF( jpnj  == 1             )   ibondj(ii,ij) = 2 
    202  
    203204         ibondi(ii,ij) = 0 
    204205         IF( MOD(jarea,jpni) == 1 )   ibondi(ii,ij) = -1 
     
    308309      END DO 
    309310 
     311      nfipproc(:,:) = ipproc(:,:) 
     312 
     313 
    310314      ! Control 
    311315      IF(icont+1 /= jpnij) THEN 
  • trunk/NEMOGCM/NEMO/OPA_SRC/nemogcm.F90

    r4667 r4671  
    8686   USE sbctide, ONLY: lk_tide 
    8787   USE crsini          ! initialise grid coarsening utility 
    88    USE lbcnfd, ONLY: isendto, nsndto ! Setup of north fold exchanges  
     88   USE lbcnfd, ONLY: isendto, nsndto, nfsloop, nfeloop ! Setup of north fold exchanges  
    8989 
    9090   IMPLICIT NONE 
     
    568568      ENDIF 
    569569      ! 
     570      IF( lk_c1d .AND. .NOT.lk_iomput )   CALL ctl_stop( 'nemo_ctl: The 1D configuration must be used ',   & 
     571         &                                               'with the IOM Input/Output manager. '         ,   & 
     572         &                                               'Compile with key_iomput enabled' ) 
     573      ! 
    570574      IF( 1_wp /= SIGN(1._wp,-0._wp)  )   CALL ctl_stop( 'nemo_ctl: The intrinsec SIGN function follows ',  & 
    571575         &                                               'f2003 standard. '                              ,  & 
     
    799803          !loop over the other north-fold processes to find the processes 
    800804          !managing the points belonging to the sxT-dxT range 
    801           DO jn = jpnij - jpni +1, jpnij 
    802              IF ( njmppt(jn) == njmppmax ) THEN 
     805   
     806          DO jn = 1, jpni 
    803807                !sxT is the first point (in the global domain) of the jn 
    804808                !process 
    805                 sxT = nimppt(jn) 
     809                sxT = nfiimpp(jn, jpnj) 
    806810                !dxT is the last point (in the global domain) of the jn 
    807811                !process 
    808                 dxT = nimppt(jn) + nlcit(jn) - 1 
     812                dxT = nfiimpp(jn, jpnj) + nfilcit(jn, jpnj) - 1 
    809813                IF ((sxM .gt. sxT) .AND. (sxM .lt. dxT)) THEN 
    810814                   nsndto = nsndto + 1 
    811                    isendto(nsndto) = jn 
     815                     isendto(nsndto) = jn 
    812816                ELSEIF ((sxM .le. sxT) .AND. (dxM .ge. dxT)) THEN 
    813817                   nsndto = nsndto + 1 
    814                    isendto(nsndto) = jn 
     818                     isendto(nsndto) = jn 
    815819                ELSEIF ((dxM .lt. dxT) .AND. (sxT .lt. dxM)) THEN 
    816820                   nsndto = nsndto + 1 
    817                    isendto(nsndto) = jn 
     821                     isendto(nsndto) = jn 
    818822                END IF 
    819              END IF 
    820823          END DO 
     824          nfsloop = 1 
     825          nfeloop = nlci 
     826          DO jn = 2,jpni-1 
     827           IF(nfipproc(jn,jpnj) .eq. (narea - 1)) THEN 
     828              IF (nfipproc(jn - 1 ,jpnj) .eq. -1) THEN 
     829                 nfsloop = nldi 
     830              ENDIF 
     831              IF (nfipproc(jn + 1,jpnj) .eq. -1) THEN 
     832                 nfeloop = nlei 
     833              ENDIF 
     834           ENDIF 
     835        END DO 
     836 
    821837      ENDIF 
    822838      l_north_nogather = .TRUE. 
Note: See TracChangeset for help on using the changeset viewer.