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 4671 for trunk/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90 – NEMO

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

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

File:
1 edited

Legend:

Unmodified
Added
Removed

  • 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 
Note: See TracChangeset for help on using the changeset viewer.