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 5034 for branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90 – NEMO

Ignore:
Timestamp:
2015-01-15T14:48:42+01:00 (9 years ago)
Author:
andrewryan
Message:

merge with trunk

File:
1 edited

Legend:

Unmodified
Added
Removed

  • branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/OPA_SRC/LBC/lbcnfd.F90

    r4230 r5034  
    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 
     425                  IF(nimpp .eq. 1) THEN 
     426                     pt3dl(1,ijpj,jk) = psgn * pt3dl(3,ijpj-2,jk) 
     427                  ENDIF 
    425428               END DO 
    426429 
    … …  
    435438                 DO jk = 1, jpk 
    436439                    DO ji = startloop, nlci 
    437                        ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 4 
     440                       ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    438441                       jia = ji + nimpp - 1 
    439442                       ijta = jpiglo - jia + 2 
    … …  
    448451 
    449452 
    450  
    451453            CASE ( 'U' )                               ! U-point 
    452                IF (narea .ne. (jpnij)) THEN 
     454               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    453455                  endloop = nlci 
    454456               ELSE 
    … …  
    457459               DO jk = 1, jpk 
    458460                  DO ji = 1, endloop 
    459                      iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     461                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    460462                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(iju,ijpj-2,jk) 
    461463                  END DO 
    462                END DO 
    463  
    464                IF (narea .ne. (jpnij)) THEN 
     464                  IF(nimpp .eq. 1) THEN 
     465                     pt3dl(   1  ,ijpj,jk) = psgn * pt3dl(    2   ,ijpj-2,jk) 
     466                  ENDIF 
     467                  IF((nimpp + nlci - 1) .eq. jpiglo) THEN 
     468                     pt3dl(nlci,ijpj,jk) = psgn * pt3dl(nlci-1,ijpj-2,jk) 
     469                  ENDIF 
     470               END DO 
     471 
     472               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    465473                  endloop = nlci 
    466474               ELSE 
    … …  
    477485                 DO jk = 1, jpk 
    478486                    DO ji = startloop, endloop 
    479                       iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     487                      iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    480488                      jia = ji + nimpp - 1 
    481489                      ijua = jpiglo - jia + 1 
    … …  
    490498 
    491499            CASE ( 'V' )                               ! V-point 
    492                IF (narea .ne. (jpnij - jpni + 1)) THEN 
     500               IF (nimpp .ne. 1) THEN 
    493501                  startloop = 1 
    494502               ELSE 
    … …  
    497505               DO jk = 1, jpk 
    498506                  DO ji = startloop, nlci 
    499                      ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 4 
     507                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    500508                     pt3dl(ji,ijpj-1,jk) = psgn * pt3dr(ijt,ijpj-2,jk) 
    501509                     pt3dl(ji,ijpj  ,jk) = psgn * pt3dr(ijt,ijpj-3,jk) 
    502510                  END DO 
     511                  IF(nimpp .eq. 1) THEN 
     512                     pt3dl(1,ijpj,jk) = psgn * pt3dl(3,ijpj-3,jk) 
     513                  ENDIF 
    503514               END DO 
    504515            CASE ( 'F' )                               ! F-point 
    505                IF (narea .ne. (jpnij)) THEN 
     516               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    506517                  endloop = nlci 
    507518               ELSE 
    … …  
    510521               DO jk = 1, jpk 
    511522                  DO ji = 1, endloop 
    512                      iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     523                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    513524                     pt3dl(ji,ijpj-1,jk) = psgn * pt3dr(iju,ijpj-2,jk) 
    514525                     pt3dl(ji,ijpj  ,jk) = psgn * pt3dr(iju,ijpj-3,jk) 
    515526                  END DO 
     527                  IF(nimpp .eq. 1) THEN 
     528                     pt3dl(   1  ,ijpj,jk) = psgn * pt3dl(    2   ,ijpj-3,jk) 
     529                  ENDIF 
     530                  IF((nimpp + nlci - 1) .eq. jpiglo) THEN 
     531                     pt3dl(nlci,ijpj,jk) = psgn * pt3dl(nlci-1,ijpj-3,jk) 
     532                  ENDIF 
    516533               END DO 
    517534            END SELECT 
    … …  
    524541               DO jk = 1, jpk 
    525542                  DO ji = 1, nlci 
    526                      ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     543                     ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    527544                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-1,jk) 
    528545                  END DO 
    … …  
    530547 
    531548            CASE ( 'U' )                               ! U-point 
    532                IF (narea .ne. (jpnij)) THEN 
     549               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    533550                  endloop = nlci 
    534551               ELSE 
    … …  
    537554               DO jk = 1, jpk 
    538555                  DO ji = 1, endloop 
    539                      iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 2 
     556                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
    540557                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(iju,ijpj-1,jk) 
    541558                  END DO 
     559                  IF((nimpp + nlci - 1) .eq. jpiglo) THEN 
     560                     pt3dl(nlci,ijpj,jk) = psgn * pt3dr(1,ijpj-1,jk) 
     561                  ENDIF 
    542562               END DO 
    543563 
    … …  
    545565               DO jk = 1, jpk 
    546566                  DO ji = 1, nlci 
    547                      ijt = jpiglo - ji- nimpp - nimppt(isendto(1)) + 3 
     567                     ijt = jpiglo - ji- nimpp - nfiimpp(isendto(1),jpnj) + 3 
    548568                     pt3dl(ji,ijpj,jk) = psgn * pt3dr(ijt,ijpj-2,jk) 
    549569                  END DO 
    … …  
    560580                 DO jk = 1, jpk 
    561581                    DO ji = startloop, nlci 
    562                        ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     582                       ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    563583                       pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(ijt,ijpjm1,jk) 
    564584                    END DO 
    … …  
    567587 
    568588            CASE ( 'F' )                               ! F-point 
    569                IF (narea .ne. (jpnij)) THEN 
     589               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    570590                  endloop = nlci 
    571591               ELSE 
    … …  
    574594               DO jk = 1, jpk 
    575595                  DO ji = 1, endloop 
    576                      iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 2 
     596                     iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
    577597                     pt3dl(ji,ijpj ,jk) = psgn * pt3dr(iju,ijpj-2,jk) 
    578598                  END DO 
    579                END DO 
    580  
    581                IF (narea .ne. (jpnij)) THEN 
     599                  IF((nimpp + nlci - 1) .eq. jpiglo) THEN 
     600                     pt3dl(nlci,ijpj,jk) = psgn * pt3dr(1,ijpj-2,jk) 
     601                  ENDIF 
     602               END DO 
     603 
     604               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    582605                  endloop = nlci 
    583606               ELSE 
    … …  
    594617                  DO jk = 1, jpk 
    595618                     DO ji = startloop, endloop 
    596                         iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 2 
     619                        iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
    597620                        pt3dl(ji,ijpjm1,jk) = psgn * pt3dr(iju,ijpjm1,jk) 
    598621                     END DO 
    … …  
    656679         ! 
    657680         CASE ( 'T' , 'W' )                               ! T- , W-points 
    658             IF (narea .ne. (jpnij - jpni + 1)) THEN 
     681            IF (nimpp .ne. 1) THEN 
    659682              startloop = 1 
    660683            ELSE 
    … …  
    662685            ENDIF 
    663686            DO ji = startloop, nlci 
    664               ijt=jpiglo - ji - nimpp - nimppt(isendto(1)) + 4 
     687              ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    665688              pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-1) 
    666689            END DO 
     690            IF (nimpp .eq. 1) THEN 
     691              pt2dl(1,ijpj)   = psgn * pt2dl(3,ijpj-2) 
     692            ENDIF 
    667693 
    668694            IF(nimpp .ge. (jpiglo/2+1)) THEN 
    … …  
    674700            ENDIF 
    675701            DO ji = startloop, nlci 
    676                ijt=jpiglo - ji - nimpp - nimppt(isendto(1)) + 4 
     702               ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    677703               jia = ji + nimpp - 1 
    678704               ijta = jpiglo - jia + 2 
    … …  
    685711 
    686712         CASE ( 'U' )                                     ! U-point 
    687             IF (narea .ne. (jpnij)) THEN 
     713            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    688714               endloop = nlci 
    689715            ELSE 
    … …  
    691717            ENDIF 
    692718            DO ji = 1, endloop 
    693                iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     719               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    694720               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-1) 
    695721            END DO 
    696722 
    697             IF (narea .ne. (jpnij)) THEN 
     723            IF (nimpp .eq. 1) THEN 
     724              pt2dl(   1  ,ijpj  ) = psgn * pt2dl(    2   ,ijpj-2) 
     725              pt2dl(1     ,ijpj-1) = psgn * pt2dr(jpiglo - nfiimpp(isendto(1), jpnj) + 1, ijpj-1) 
     726            ENDIF 
     727            IF((nimpp + nlci - 1) .eq. jpiglo) THEN 
     728              pt2dl(nlci,ijpj  ) = psgn * pt2dl(nlci-1,ijpj-2) 
     729            ENDIF 
     730 
     731            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    698732               endloop = nlci 
    699733            ELSE 
    … …  
    708742            ENDIF 
    709743            DO ji = startloop, endloop 
    710                iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     744               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    711745               jia = ji + nimpp - 1 
    712746               ijua = jpiglo - jia + 1 
    … …  
    719753 
    720754         CASE ( 'V' )                                     ! V-point 
    721             IF (narea .ne. (jpnij - jpni + 1)) THEN 
     755            IF (nimpp .ne. 1) THEN 
    722756              startloop = 1 
    723757            ELSE 
    … …  
    725759            ENDIF 
    726760            DO ji = startloop, nlci 
    727               ijt=jpiglo - ji - nimpp - nimppt(isendto(1)) + 4 
     761              ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    728762              pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1-1) 
    729763              pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-2) 
    730764            END DO 
     765            IF (nimpp .eq. 1) THEN 
     766              pt2dl( 1 ,ijpj)   = psgn * pt2dl( 3 ,ijpj-3)  
     767            ENDIF 
    731768 
    732769         CASE ( 'F' )                                     ! F-point 
    733             IF (narea .ne. (jpnij)) THEN 
     770            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    734771               endloop = nlci 
    735772            ELSE 
    … …  
    737774            ENDIF 
    738775            DO ji = 1, endloop 
    739                iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     776               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    740777               pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1-1) 
    741778               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-2) 
    742779            END DO 
     780            IF (nimpp .eq. 1) THEN 
     781              pt2dl(   1  ,ijpj)   = psgn * pt2dl(    2   ,ijpj-3) 
     782              pt2dl(   1  ,ijpj-1) = psgn * pt2dl(    2   ,ijpj-2) 
     783            ENDIF 
     784            IF((nimpp + nlci - 1) .eq. jpiglo) THEN 
     785              pt2dl(nlci,ijpj)   = psgn * pt2dl(nlci-1,ijpj-3) 
     786              pt2dl(nlci,ijpj-1) = psgn * pt2dl(nlci-1,ijpj-2)  
     787            ENDIF 
    743788 
    744789         CASE ( 'I' )                                     ! ice U-V point (I-point) 
    745             IF (narea .ne. (jpnij - jpni + 1)) THEN 
     790            IF (nimpp .ne. 1) THEN 
    746791               startloop = 1 
    747792            ELSE 
    … …  
    750795            ENDIF 
    751796            DO ji = startloop, nlci 
    752                iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 5 
     797               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5 
    753798               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1) 
    754799            END DO 
    755800 
    756801         CASE ( 'J' )                                     ! first ice U-V point 
    757             IF (narea .ne. (jpnij - jpni + 1)) THEN 
     802            IF (nimpp .ne. 1) THEN 
    758803               startloop = 1 
    759804            ELSE 
    … …  
    762807            ENDIF 
    763808            DO ji = startloop, nlci 
    764                iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 5 
     809               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5 
    765810               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1) 
    766811            END DO 
    767812 
    768813         CASE ( 'K' )                                     ! second ice U-V point 
    769             IF (narea .ne. (jpnij - jpni + 1)) THEN 
     814            IF (nimpp .ne. 1) THEN 
    770815               startloop = 1 
    771816            ELSE 
    … …  
    774819            ENDIF 
    775820            DO ji = startloop, nlci 
    776                iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 5 
     821               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 5 
    777822               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1) 
    778823            END DO 
    … …  
    785830         CASE ( 'T' , 'W' )                               ! T-, W-point 
    786831            DO ji = 1, nlci 
    787                ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     832               ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    788833               pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1) 
    789834            END DO 
    790835 
    791836         CASE ( 'U' )                                     ! U-point 
    792             IF (narea .ne. (jpnij)) THEN 
     837            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    793838               endloop = nlci 
    794839            ELSE 
    … …  
    796841            ENDIF 
    797842            DO ji = 1, endloop 
    798                iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 2 
     843               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
    799844               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1) 
    800845            END DO 
     846            IF((nimpp + nlci - 1) .eq. jpiglo) THEN 
     847               pt2dl(nlci,ijpj) = psgn * pt2dr(1,ijpj-1) 
     848            ENDIF 
    801849 
    802850         CASE ( 'V' )                                     ! V-point 
    803851            DO ji = 1, nlci 
    804                ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     852               ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    805853               pt2dl(ji,ijpj) = psgn * pt2dr(ijt,ijpjm1-1) 
    806854            END DO 
    … …  
    813861            ENDIF 
    814862            DO ji = startloop, nlci 
    815                ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 3 
     863               ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    816864               pt2dl(ji,ijpjm1) = psgn * pt2dr(ijt,ijpjm1) 
    817865            END DO 
    818866 
    819867         CASE ( 'F' )                               ! F-point 
    820             IF (narea .ne. (jpnij)) THEN 
     868            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    821869               endloop = nlci 
    822870            ELSE 
    … …  
    824872            ENDIF 
    825873            DO ji = 1, endloop 
    826                iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 2 
     874               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
    827875               pt2dl(ji,ijpj) = psgn * pt2dr(iju,ijpjm1-1) 
    828876            END DO 
    829  
    830             IF (narea .ne. (jpnij)) THEN 
     877            IF((nimpp + nlci - 1) .eq. jpiglo) THEN 
     878                pt2dl(nlci,ijpj) = psgn * pt2dr(1,ijpj-2) 
     879            ENDIF 
     880 
     881            IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    831882               endloop = nlci 
    832883            ELSE 
    … …  
    842893 
    843894            DO ji = startloop, endloop 
    844                iju = jpiglo - ji - nimpp - nimppt(isendto(1)) + 2 
     895               iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
    845896               pt2dl(ji,ijpjm1) = psgn * pt2dr(iju,ijpjm1) 
    846897            END DO 
    847898 
    848899         CASE ( 'I' )                                  ! ice U-V point (I-point) 
    849                IF (narea .ne. (jpnij - jpni + 1)) THEN 
     900               IF (nimpp .ne. 1) THEN 
    850901                  startloop = 1 
    851902               ELSE 
    852903                  startloop = 2 
    853904               ENDIF 
    854                IF (narea .ne. jpnij) THEN 
     905               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    855906                  endloop = nlci 
    856907               ELSE 
    … …  
    858909               ENDIF 
    859910               DO ji = startloop , endloop 
    860                   ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 4 
     911                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    861912                  pt2dl(ji,ijpj)= 0.5 * (pt2dr(ji,ijpjm1) + psgn * pt2dr(ijt,ijpjm1)) 
    862913               END DO 
    863914 
    864915         CASE ( 'J' )                                  ! first ice U-V point 
    865                IF (narea .ne. (jpnij - jpni + 1)) THEN 
     916               IF (nimpp .ne. 1) THEN 
    866917                  startloop = 1 
    867918               ELSE 
    868919                  startloop = 2 
    869920               ENDIF 
    870                IF (narea .ne. jpnij) THEN 
     921               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    871922                  endloop = nlci 
    872923               ELSE 
    … …  
    874925               ENDIF 
    875926               DO ji = startloop , endloop 
    876                   ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 4 
     927                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    877928                  pt2dl(ji,ijpj) = pt2dr(ji,ijpjm1) 
    878929               END DO 
    879930 
    880931         CASE ( 'K' )                                  ! second ice U-V point 
    881                IF (narea .ne. (jpnij - jpni + 1)) THEN 
     932               IF (nimpp .ne. 1) THEN 
    882933                  startloop = 1 
    883934               ELSE 
    884935                  startloop = 2 
    885936               ENDIF 
    886                IF (narea .ne. jpnij) THEN 
     937               IF ((nimpp + nlci - 1) .ne. jpiglo) THEN 
    887938                  endloop = nlci 
    888939               ELSE 
    … …  
    890941               ENDIF 
    891942               DO ji = startloop, endloop 
    892                   ijt = jpiglo - ji - nimpp - nimppt(isendto(1)) + 4 
     943                  ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    893944                  pt2dl(ji,ijpj) = pt2dr(ijt,ijpjm1) 
    894945               END DO 
Note: See TracChangeset for help on using the changeset viewer.