Changeset 8860


Ignore:
Timestamp:
2017-11-30T16:11:05+01:00 (3 years ago)
Author:
acc
Message:

Branch 2017/dev_r8126_ROBUST08_no_ghost. Revamp of extended halo north-fold icb routines which makes the logic cleaner and more understandable. Sucessfully SETTE tested and continuity of trajectories across the north-fold have been verified

Location:
branches/2017/dev_r8126_ROBUST08_no_ghost/NEMOGCM/NEMO/OPA_SRC/LBC
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_r8126_ROBUST08_no_ghost/NEMOGCM/NEMO/OPA_SRC/LBC/lbc_nfd_ext_generic.h90

    r8854 r8860  
    1010#define ARRAY_TYPE(i,j,k,l,f)    REAL(wp),INTENT(inout)::ARRAY_IN(i,j,k,l,f) 
    1111 
    12    SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn, ipr2dj ) 
     12   SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn, kextj ) 
    1313      ARRAY_TYPE(:,:,:,:,:)                             ! array or pointer of arrays on which the boundary condition is applied 
    1414      CHARACTER(len=1) , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points 
    1515      REAL(wp)         , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary 
    16       INTEGER          , INTENT(in   ) ::   ipr2dj      ! extra halo width to exchange 
     16      INTEGER          , INTENT(in   ) ::   kextj       ! extra halo width at north fold 
    1717      ! 
    1818      INTEGER  ::    ji,  jj,  jk,  jl, jh,  jf   ! dummy loop indices 
     
    3131      END SELECT 
    3232      ! 
    33       IF (jpni > 1 ) ipj = ipj + ipr2dj 
    34       ! 
    3533      ipjm1 = ipj-1 
    3634 
     
    4442            SELECT CASE ( NAT_IN(jf)  ) 
    4543            CASE ( 'T' , 'W' )                         ! T-, W-point 
    46                DO jh = 0, ipr2dj 
     44               DO jh = 0, kextj 
    4745                  DO ji = 2, jpiglo 
    4846                     ijt = jpiglo-ji+2 
     
    5654               END DO 
    5755            CASE ( 'U' )                               ! U-point 
    58                DO jh = 0, ipr2dj 
     56               DO jh = 0, kextj 
    5957                  DO ji = 1, jpiglo-1 
    6058                     iju = jpiglo-ji+1 
     
    6967               END DO 
    7068            CASE ( 'V' )                               ! V-point 
    71                DO jh = 0, ipr2dj 
     69               DO jh = 0, kextj 
    7270                  DO ji = 2, jpiglo 
    7371                     ijt = jpiglo-ji+2 
     
    7876               END DO 
    7977            CASE ( 'F' )                               ! F-point 
    80                DO jh = 0, ipr2dj 
     78               DO jh = 0, kextj 
    8179                  DO ji = 1, jpiglo-1 
    8280                     iju = jpiglo-ji+1 
     
    9391            SELECT CASE ( NAT_IN(jf)  ) 
    9492            CASE ( 'T' , 'W' )                         ! T-, W-point 
    95                DO jh = 0, ipr2dj 
     93               DO jh = 0, kextj 
    9694                  DO ji = 1, jpiglo 
    9795                     ijt = jpiglo-ji+1 
     
    10098               END DO 
    10199            CASE ( 'U' )                               ! U-point 
    102                DO jh = 0, ipr2dj 
     100               DO jh = 0, kextj 
    103101                  DO ji = 1, jpiglo-1 
    104102                     iju = jpiglo-ji 
     
    108106               END DO 
    109107            CASE ( 'V' )                               ! V-point 
    110                DO jh = 0, ipr2dj 
     108               DO jh = 0, kextj 
    111109                  DO ji = 1, jpiglo 
    112110                     ijt = jpiglo-ji+1 
     
    119117               END DO 
    120118            CASE ( 'F' )                               ! F-point 
    121                DO jh = 0, ipr2dj 
     119               DO jh = 0, kextj 
    122120                  DO ji = 1, jpiglo-1 
    123121                     iju = jpiglo-ji 
     
    136134            SELECT CASE ( NAT_IN(jf) ) 
    137135            CASE ( 'T' , 'U' , 'V' , 'W' )             ! T-, U-, V-, W-points 
    138                ARRAY_IN(:,  1:1-ipr2dj  ,:,:,jf) = 0._wp 
    139                ARRAY_IN(:,ipj:ipj+ipr2dj,:,:,jf) = 0._wp 
     136               ARRAY_IN(:,  1:1-kextj  ,:,:,jf) = 0._wp 
     137               ARRAY_IN(:,ipj:ipj+kextj,:,:,jf) = 0._wp 
    140138            CASE ( 'F' )                               ! F-point 
    141                ARRAY_IN(:,ipj:ipj+ipr2dj,:,:,jf) = 0._wp 
     139               ARRAY_IN(:,ipj:ipj+kextj,:,:,jf) = 0._wp 
    142140            END SELECT 
    143141            ! 
  • branches/2017/dev_r8126_ROBUST08_no_ghost/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r8811 r8860  
    13391339 
    13401340 
    1341    SUBROUTINE mpp_lbc_north_icb( pt2d, cd_type, psgn, ipr2dj) 
     1341   SUBROUTINE mpp_lbc_north_icb( pt2d, cd_type, psgn, kextj) 
    13421342      !!--------------------------------------------------------------------- 
    13431343      !!                   ***  routine mpp_lbc_north_icb  *** 
     
    13491349      !! ** Method  :   North fold condition and mpp with more than one proc 
    13501350      !!              in i-direction require a specific treatment. We gather 
    1351       !!              the 4+2*jpr2dj northern lines of the global domain on 1 
     1351      !!              the 4+kextj northern lines of the global domain on 1 
    13521352      !!              processor and apply lbc north-fold on this sub array. 
    13531353      !!              Then we scatter the north fold array back to the processors. 
     
    13611361      REAL(wp)                , INTENT(in   ) ::   psgn     ! = -1. the sign change across the 
    13621362      !!                                                    ! north fold, =  1. otherwise 
    1363       INTEGER                 , INTENT(in   ) ::   ipr2dj 
     1363      INTEGER                 , INTENT(in   ) ::   kextj    ! Extra halo width at north fold 
    13641364      ! 
    13651365      INTEGER ::   ji, jj, jr 
     
    13721372      ! 
    13731373      ipj=4 
    1374       ALLOCATE( ztab_e(jpiglo,4+2*ipr2dj), znorthloc_e(jpimax,4+2*ipr2dj), znorthgloio_e(jpimax,4+2*ipr2dj,jpni) ) 
     1374      ALLOCATE( ztab_e(jpiglo,ipj+kextj), znorthloc_e(  jpimax,ipj+kextj), & 
     1375     &                                    znorthgloio_e(jpimax,ipj+kextj,jpni) ) 
    13751376      ! 
    13761377      ztab_e(:,:)      = 0._wp 
     
    13781379      ! 
    13791380      ij = 0 
    1380       ! put the last 4+2*ipr2dj lines of pt2d into znorthloc_e  
    1381       DO jj = jpj - ipj + 1 - ipr2dj, jpj +ipr2dj 
     1381      ! put the last ipj+kextj lines of pt2d into znorthloc_e  
     1382      DO jj = jpj - ipj + 1, jpj + kextj 
    13821383         ij = ij + 1 
    13831384         znorthloc_e(1:jpi,ij)=pt2d(1:jpi,jj) 
    13841385      END DO 
    13851386      ! 
    1386       itaille = jpimax * ( ipj + 2 * ipr2dj ) 
     1387      itaille = jpimax * ( ipj + kextj ) 
    13871388      CALL MPI_ALLGATHER( znorthloc_e(1,1)  , itaille, MPI_DOUBLE_PRECISION,    & 
    13881389         &                znorthgloio_e(1,1,1), itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 
     
    13931394         ilei = nleit (iproc) 
    13941395         iilb = nimppt(iproc) 
    1395          DO jj = 1, ipj+2*ipr2dj 
     1396         DO jj = 1, ipj+kextj 
    13961397            DO ji = ildi, ilei 
    13971398               ztab_e(ji+iilb-1,jj) = znorthgloio_e(ji,jj,jr) 
     
    14021403      ! 2. North-Fold boundary conditions 
    14031404      ! ---------------------------------- 
    1404       CALL lbc_nfd( ztab_e(:,:), cd_type, psgn, ipr2dj ) 
    1405  
    1406       ij = ipr2dj 
     1405      CALL lbc_nfd( ztab_e(:,:), cd_type, psgn, kextj ) 
     1406 
     1407      ij = 0 
    14071408      !! Scatter back to pt2d 
    1408       DO jj = jpj - ipj + 1 , jpj +ipr2dj 
     1409      DO jj = jpj - ipj + 1 , jpj + kextj 
    14091410      ij  = ij +1 
    14101411         DO ji= 1, jpi 
     
    14181419 
    14191420 
    1420    SUBROUTINE mpp_lnk_2d_icb( pt2d, cd_type, psgn, jpri, jprj ) 
     1421   SUBROUTINE mpp_lnk_2d_icb( pt2d, cd_type, psgn, kexti, kextj ) 
    14211422      !!---------------------------------------------------------------------- 
    14221423      !!                  ***  routine mpp_lnk_2d_icb  *** 
    14231424      !! 
    14241425      !! ** Purpose :   Message passing management for 2d array (with extra halo for icebergs) 
    1425       !!                This routine receives a (1-jpri:jpi+jpri,1-jpri:jpj+jprj) 
     1426      !!                This routine receives a (1-kexti:jpi+kexti,1-kexti:jpj+kextj) 
    14261427      !!                array (usually (0:jpi+1, 0:jpj+1)) from lbc_lnk_icb calls. 
    14271428      !! 
     
    14311432      !!                    jpi    : first dimension of the local subdomain 
    14321433      !!                    jpj    : second dimension of the local subdomain 
    1433       !!                    jpri   : number of rows for extra outer halo 
    1434       !!                    jprj   : number of columns for extra outer halo 
     1434      !!                    kexti  : number of columns for extra outer halo 
     1435      !!                    kextj  : number of rows for extra outer halo 
    14351436      !!                    nbondi : mark for "east-west local boundary" 
    14361437      !!                    nbondj : mark for "north-south local boundary" 
     
    14401441      !!                    nono   : number for local neighboring processors 
    14411442      !!---------------------------------------------------------------------- 
    1442       REAL(wp), DIMENSION(1-jpri:jpi+jpri,1-jprj:jpj+jprj), INTENT(inout) ::   pt2d     ! 2D array with extra halo 
    1443       CHARACTER(len=1)                                    , INTENT(in   ) ::   cd_type  ! nature of ptab array grid-points 
    1444       REAL(wp)                                            , INTENT(in   ) ::   psgn     ! sign used across the north fold 
    1445       INTEGER                                             , INTENT(in   ) ::   jpri 
    1446       INTEGER                                             , INTENT(in   ) ::   jprj 
     1443      REAL(wp), DIMENSION(1-kexti:jpi+kexti,1-kextj:jpj+kextj), INTENT(inout) ::   pt2d     ! 2D array with extra halo 
     1444      CHARACTER(len=1)                                        , INTENT(in   ) ::   cd_type  ! nature of ptab array grid-points 
     1445      REAL(wp)                                                , INTENT(in   ) ::   psgn     ! sign used across the north fold 
     1446      INTEGER                                                 , INTENT(in   ) ::   kexti    ! extra i-halo width 
     1447      INTEGER                                                 , INTENT(in   ) ::   kextj    ! extra j-halo width 
    14471448      ! 
    14481449      INTEGER  ::   jl   ! dummy loop indices 
     
    14521453      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend 
    14531454      !! 
    1454       REAL(wp), DIMENSION(1-jpri:jpi+jpri,nn_hls+jprj,2) ::   r2dns, r2dsn 
    1455       REAL(wp), DIMENSION(1-jprj:jpj+jprj,nn_hls+jpri,2) ::   r2dwe, r2dew 
    1456       !!---------------------------------------------------------------------- 
    1457  
    1458       ipreci = nn_hls + jpri      ! take into account outer extra 2D overlap area 
    1459       iprecj = nn_hls + jprj 
     1455      REAL(wp), DIMENSION(1-kexti:jpi+kexti,nn_hls+kextj,2) ::   r2dns, r2dsn 
     1456      REAL(wp), DIMENSION(1-kextj:jpj+kextj,nn_hls+kexti,2) ::   r2dwe, r2dew 
     1457      !!---------------------------------------------------------------------- 
     1458 
     1459      ipreci = nn_hls + kexti      ! take into account outer extra 2D overlap area 
     1460      iprecj = nn_hls + kextj 
    14601461 
    14611462 
     
    14671468      !                                           !* Cyclic east-west 
    14681469      IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 
    1469          pt2d(1-jpri:     1    ,:) = pt2d(jpim1-jpri:  jpim1 ,:)       ! east 
    1470          pt2d(   jpi  :jpi+jpri,:) = pt2d(     2      :2+jpri,:)       ! west 
     1470         pt2d(1-kexti:     1    ,:) = pt2d(jpim1-kexti:  jpim1 ,:)       ! east 
     1471         pt2d(   jpi  :jpi+kexti,:) = pt2d(     2      :2+kexti,:)       ! west 
    14711472         ! 
    14721473      ELSE                                        !* closed 
    1473          IF( .NOT. cd_type == 'F' )   pt2d(  1-jpri   :nn_hls    ,:) = 0._wp    ! south except at F-point 
    1474                                       pt2d(jpi-nn_hls+1:jpi+jpri,:) = 0._wp    ! north 
     1474         IF( .NOT. cd_type == 'F' )   pt2d(  1-kexti   :nn_hls    ,:) = 0._wp    ! south except at F-point 
     1475                                      pt2d(jpi-nn_hls+1:jpi+kexti,:) = 0._wp    ! north 
    14751476      ENDIF 
    14761477      ! 
     
    14811482         ! 
    14821483         SELECT CASE ( jpni ) 
    1483                    CASE ( 1 )     ;   CALL lbc_nfd        ( pt2d(1:jpi,1:jpj+jprj), cd_type, psgn, jprj ) 
    1484                    CASE DEFAULT   ;   CALL mpp_lbc_north_icb( pt2d(1:jpi,1:jpj+jprj)  , cd_type, psgn , jprj ) 
     1484                   CASE ( 1 )     ;   CALL lbc_nfd          ( pt2d(1:jpi,1:jpj+kextj), cd_type, psgn, kextj ) 
     1485                   CASE DEFAULT   ;   CALL mpp_lbc_north_icb( pt2d(1:jpi,1:jpj+kextj), cd_type, psgn, kextj ) 
    14851486         END SELECT 
    14861487         ! 
     
    14931494      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
    14941495      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case) 
    1495          iihom = jpi-nreci-jpri 
     1496         iihom = jpi-nreci-kexti 
    14961497         DO jl = 1, ipreci 
    14971498            r2dew(:,jl,1) = pt2d(nn_hls+jl,:) 
     
    15011502      ! 
    15021503      !                           ! Migrations 
    1503       imigr = ipreci * ( jpj + 2*jprj) 
     1504      imigr = ipreci * ( jpj + 2*kextj ) 
    15041505      ! 
    15051506      SELECT CASE ( nbondi ) 
    15061507      CASE ( -1 ) 
    1507          CALL mppsend( 2, r2dwe(1-jprj,1,1), imigr, noea, ml_req1 ) 
    1508          CALL mpprecv( 1, r2dew(1-jprj,1,2), imigr, noea ) 
     1508         CALL mppsend( 2, r2dwe(1-kextj,1,1), imigr, noea, ml_req1 ) 
     1509         CALL mpprecv( 1, r2dew(1-kextj,1,2), imigr, noea ) 
    15091510         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    15101511      CASE ( 0 ) 
    1511          CALL mppsend( 1, r2dew(1-jprj,1,1), imigr, nowe, ml_req1 ) 
    1512          CALL mppsend( 2, r2dwe(1-jprj,1,1), imigr, noea, ml_req2 ) 
    1513          CALL mpprecv( 1, r2dew(1-jprj,1,2), imigr, noea ) 
    1514          CALL mpprecv( 2, r2dwe(1-jprj,1,2), imigr, nowe ) 
     1512         CALL mppsend( 1, r2dew(1-kextj,1,1), imigr, nowe, ml_req1 ) 
     1513         CALL mppsend( 2, r2dwe(1-kextj,1,1), imigr, noea, ml_req2 ) 
     1514         CALL mpprecv( 1, r2dew(1-kextj,1,2), imigr, noea ) 
     1515         CALL mpprecv( 2, r2dwe(1-kextj,1,2), imigr, nowe ) 
    15151516         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    15161517         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 
    15171518      CASE ( 1 ) 
    1518          CALL mppsend( 1, r2dew(1-jprj,1,1), imigr, nowe, ml_req1 ) 
    1519          CALL mpprecv( 2, r2dwe(1-jprj,1,2), imigr, nowe ) 
     1519         CALL mppsend( 1, r2dew(1-kextj,1,1), imigr, nowe, ml_req1 ) 
     1520         CALL mpprecv( 2, r2dwe(1-kextj,1,2), imigr, nowe ) 
    15201521         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    15211522      END SELECT 
     
    15311532      CASE ( 0 ) 
    15321533         DO jl = 1, ipreci 
    1533             pt2d(jl-jpri,:) = r2dwe(:,jl,2) 
    1534             pt2d( iihom+jl,:) = r2dew(:,jl,2) 
     1534            pt2d(jl-kexti,:) = r2dwe(:,jl,2) 
     1535            pt2d(iihom+jl,:) = r2dew(:,jl,2) 
    15351536         END DO 
    15361537      CASE ( 1 ) 
    15371538         DO jl = 1, ipreci 
    1538             pt2d(jl-jpri,:) = r2dwe(:,jl,2) 
     1539            pt2d(jl-kexti,:) = r2dwe(:,jl,2) 
    15391540         END DO 
    15401541      END SELECT 
     
    15461547      ! 
    15471548      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions 
    1548          ijhom = jpj-nrecj-jprj 
     1549         ijhom = jpj-nrecj-kextj 
    15491550         DO jl = 1, iprecj 
    15501551            r2dsn(:,jl,1) = pt2d(:,ijhom +jl) 
     
    15541555      ! 
    15551556      !                           ! Migrations 
    1556       imigr = iprecj * ( jpi + 2*jpri ) 
     1557      imigr = iprecj * ( jpi + 2*kexti ) 
    15571558      ! 
    15581559      SELECT CASE ( nbondj ) 
    15591560      CASE ( -1 ) 
    1560          CALL mppsend( 4, r2dsn(1-jpri,1,1), imigr, nono, ml_req1 ) 
    1561          CALL mpprecv( 3, r2dns(1-jpri,1,2), imigr, nono ) 
     1561         CALL mppsend( 4, r2dsn(1-kexti,1,1), imigr, nono, ml_req1 ) 
     1562         CALL mpprecv( 3, r2dns(1-kexti,1,2), imigr, nono ) 
    15621563         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    15631564      CASE ( 0 ) 
    1564          CALL mppsend( 3, r2dns(1-jpri,1,1), imigr, noso, ml_req1 ) 
    1565          CALL mppsend( 4, r2dsn(1-jpri,1,1), imigr, nono, ml_req2 ) 
    1566          CALL mpprecv( 3, r2dns(1-jpri,1,2), imigr, nono ) 
    1567          CALL mpprecv( 4, r2dsn(1-jpri,1,2), imigr, noso ) 
     1565         CALL mppsend( 3, r2dns(1-kexti,1,1), imigr, noso, ml_req1 ) 
     1566         CALL mppsend( 4, r2dsn(1-kexti,1,1), imigr, nono, ml_req2 ) 
     1567         CALL mpprecv( 3, r2dns(1-kexti,1,2), imigr, nono ) 
     1568         CALL mpprecv( 4, r2dsn(1-kexti,1,2), imigr, noso ) 
    15681569         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    15691570         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 
    15701571      CASE ( 1 ) 
    1571          CALL mppsend( 3, r2dns(1-jpri,1,1), imigr, noso, ml_req1 ) 
    1572          CALL mpprecv( 4, r2dsn(1-jpri,1,2), imigr, noso ) 
     1572         CALL mppsend( 3, r2dns(1-kexti,1,1), imigr, noso, ml_req1 ) 
     1573         CALL mpprecv( 4, r2dsn(1-kexti,1,2), imigr, noso ) 
    15731574         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    15741575      END SELECT 
     
    15841585      CASE ( 0 ) 
    15851586         DO jl = 1, iprecj 
    1586             pt2d(:,jl-jprj) = r2dsn(:,jl,2) 
    1587             pt2d(:,ijhom+jl ) = r2dns(:,jl,2) 
     1587            pt2d(:,jl-kextj) = r2dsn(:,jl,2) 
     1588            pt2d(:,ijhom+jl) = r2dns(:,jl,2) 
    15881589         END DO 
    15891590      CASE ( 1 ) 
    15901591         DO jl = 1, iprecj 
    1591             pt2d(:,jl-jprj) = r2dsn(:,jl,2) 
     1592            pt2d(:,jl-kextj) = r2dsn(:,jl,2) 
    15921593         END DO 
    15931594      END SELECT 
Note: See TracChangeset for help on using the changeset viewer.