Ignore:
Timestamp:
2017-12-13T14:57:33+01:00 (3 years ago)
Author:
acc
Message:

Branch dev_CNRS_2017. Merge in no_ghost changes from dev_r8126_ROBUST08_no_ghost. These changes include lib_mpp refresh and rationalisation of mppini from dev_r8126_ROBUST10_MPPINI

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2017/dev_CNRS_2017/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r8882 r9012  
    4141   !!   mynode        : indentify the processor unit 
    4242   !!   mpp_lnk       : interface (defined in lbclnk) for message passing of 2d or 3d arrays (mpp_lnk_2d, mpp_lnk_3d) 
    43    !!   mpp_lnk_e     : interface (defined in lbclnk) for message passing of 2d array with extra halo (mpp_lnk_2d_e) 
    4443   !!   mpp_lnk_icb   : interface for message passing of 2d arrays with extra halo for icebergs (mpp_lnk_2d_icb) 
    4544   !!   mpprecv       : 
     
    5554   !!   mppstop       : 
    5655   !!   mpp_ini_north : initialisation of north fold 
    57 !!gm   !!   mpp_lbc_north : north fold processors gathering 
    58    !!   mpp_lbc_north_e : variant of mpp_lbc_north for extra outer halo 
    59    !!   mpp_lbc_north_icb : variant of mpp_lbc_north for extra outer halo with icebergs 
     56   !!   mpp_lbc_north_icb : alternative to mpp_nfd for extra outer halo with icebergs 
    6057   !!---------------------------------------------------------------------- 
    6158   USE dom_oce        ! ocean space and time domain 
     
    7572   PUBLIC   mpp_lnk_2d      , mpp_lnk_3d      , mpp_lnk_4d 
    7673   PUBLIC   mpp_lnk_2d_ptr, mpp_lnk_3d_ptr, mpp_lnk_4d_ptr 
    77    PUBLIC   mpp_lnk_2d_e 
    7874   ! 
    7975!!gm  this should be useless 
     
    8480   PUBLIC   ctl_stop, ctl_warn, get_unit, ctl_opn, ctl_nam 
    8581   PUBLIC   mynode, mppstop, mppsync, mpp_comm_free 
    86    PUBLIC   mpp_ini_north, mpp_lbc_north_e 
    87 !!gm   PUBLIC   mpp_ini_north, mpp_lbc_north, mpp_lbc_north_e 
    88    PUBLIC   mpp_lbc_north_icb, mpp_lnk_2d_icb 
     82   PUBLIC   mpp_ini_north 
     83   PUBLIC   mpp_lnk_2d_icb 
     84   PUBLIC   mpp_lbc_north_icb 
    8985   PUBLIC   mpp_min, mpp_max, mpp_sum, mpp_minloc, mpp_maxloc 
    9086   PUBLIC   mpp_max_multiple 
    91 !!gm   PUBLIC   mpp_lnk_2d_9  
    92 !!gm   PUBLIC   mpp_lnk_sum_3d, mpp_lnk_sum_2d 
    9387   PUBLIC   mppscatter, mppgather 
    9488   PUBLIC   mpp_ini_ice, mpp_ini_znl 
     
    112106         &             mppsum_realdd, mppsum_a_realdd 
    113107   END INTERFACE 
    114 !!gm   INTERFACE mpp_lbc_north 
    115 !!gm      MODULE PROCEDURE mpp_lbc_north_3d, mpp_lbc_north_2d 
    116 !!gm   END INTERFACE 
    117108   INTERFACE mpp_minloc 
    118109      MODULE PROCEDURE mpp_minloc2d ,mpp_minloc3d 
     
    145136 
    146137   ! variables used in case of sea-ice 
    147    INTEGER, PUBLIC ::   ncomm_ice       !: communicator made by the processors with sea-ice (public so that it can be freed in icethd) 
     138   INTEGER, PUBLIC ::   ncomm_ice       !: communicator made by the processors with sea-ice (public so that it can be freed in limthd) 
    148139   INTEGER         ::   ngrp_iworld     !  group ID for the world processors (for rheology) 
    149140   INTEGER         ::   ngrp_ice        !  group ID for the ice processors (for rheology) 
     
    454445#     include "mpp_bdy_generic.h90" 
    455446#     undef ROUTINE_BDY 
    456 #     define MULTI 
    457 #     define ROUTINE_BDY           mpp_lnk_bdy_2d_ptr 
    458 #     include "mpp_bdy_generic.h90" 
    459 #     undef ROUTINE_BDY 
    460 #     undef MULTI 
    461447#  undef DIM_2d 
    462448   ! 
     
    467453#     include "mpp_bdy_generic.h90" 
    468454#     undef ROUTINE_BDY 
    469 #     define MULTI 
    470 #     define ROUTINE_BDY           mpp_lnk_bdy_3d_ptr 
    471 #     include "mpp_bdy_generic.h90" 
    472 #     undef ROUTINE_BDY 
    473 #     undef MULTI 
    474455#  undef DIM_3d 
    475456   ! 
     
    480461!!#     include "mpp_bdy_generic.h90" 
    481462!!#     undef ROUTINE_BDY 
    482 !!#     define MULTI 
    483 !!#     define ROUTINE_BDY           mpp_lnk_bdy_4d_ptr 
    484 !!#     include "mpp_bdy_generic.h90" 
    485 !!#     undef ROUTINE_BDY 
    486 !!#     undef MULTI 
    487463!!#  undef DIM_4d 
    488464 
     
    492468    
    493469    
    494    !!    mpp_lnk_2d_e     utilisé dans ICB  
    495  
    496  
    497470   !!    mpp_lnk_sum_2d et 3D   ====>>>>>>   à virer du code !!!! 
    498471    
     
    500473   !!---------------------------------------------------------------------- 
    501474 
    502  
    503    SUBROUTINE mpp_lnk_2d_e( pt2d, cd_type, psgn, jpri, jprj ) 
    504       !!---------------------------------------------------------------------- 
    505       !!                  ***  routine mpp_lnk_2d_e  *** 
    506       !! 
    507       !! ** Purpose :   Message passing manadgement for 2d array (with halo) 
    508       !! 
    509       !! ** Method  :   Use mppsend and mpprecv function for passing mask 
    510       !!      between processors following neighboring subdomains. 
    511       !!            domain parameters 
    512       !!                    nlci   : first dimension of the local subdomain 
    513       !!                    nlcj   : second dimension of the local subdomain 
    514       !!                    jpri   : number of rows for extra outer halo 
    515       !!                    jprj   : number of columns for extra outer halo 
    516       !!                    nbondi : mark for "east-west local boundary" 
    517       !!                    nbondj : mark for "north-south local boundary" 
    518       !!                    noea   : number for local neighboring processors 
    519       !!                    nowe   : number for local neighboring processors 
    520       !!                    noso   : number for local neighboring processors 
    521       !!                    nono   : number for local neighboring processors 
    522       !! 
    523       !!---------------------------------------------------------------------- 
    524       INTEGER                                             , INTENT(in   ) ::   jpri 
    525       INTEGER                                             , INTENT(in   ) ::   jprj 
    526       REAL(wp), DIMENSION(1-jpri:jpi+jpri,1-jprj:jpj+jprj), INTENT(inout) ::   pt2d     ! 2D array with extra halo 
    527       CHARACTER(len=1)                                    , INTENT(in   ) ::   cd_type  ! nature of ptab array grid-points 
    528       !                                                                                 ! = T , U , V , F , W and I points 
    529       REAL(wp)                                            , INTENT(in   ) ::   psgn     ! =-1 the sign change across the 
    530       !!                                                                                ! north boundary, =  1. otherwise 
    531       INTEGER  ::   jl   ! dummy loop indices 
    532       INTEGER  ::   imigr, iihom, ijhom        ! temporary integers 
    533       INTEGER  ::   ipreci, iprecj             ! temporary integers 
    534       INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend 
    535       INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend 
    536       !! 
    537       REAL(wp), DIMENSION(1-jpri:jpi+jpri,jprecj+jprj,2) :: r2dns 
    538       REAL(wp), DIMENSION(1-jpri:jpi+jpri,jprecj+jprj,2) :: r2dsn 
    539       REAL(wp), DIMENSION(1-jprj:jpj+jprj,jpreci+jpri,2) :: r2dwe 
    540       REAL(wp), DIMENSION(1-jprj:jpj+jprj,jpreci+jpri,2) :: r2dew 
    541       !!---------------------------------------------------------------------- 
    542  
    543       ipreci = jpreci + jpri      ! take into account outer extra 2D overlap area 
    544       iprecj = jprecj + jprj 
    545  
    546  
    547       ! 1. standard boundary treatment   (CAUTION: the order matters Here !!!! ) 
    548       ! ------------------------------ 
    549       !                                !== North-South boundaries 
    550       !                                      !* cyclic 
    551       IF( nbondj == 2 .AND. jperio == 7 ) THEN 
    552          pt2d(:, 1-jprj:  1     ) = pt2d ( :, jpjm1-jprj:jpjm1 ) 
    553          pt2d(:, jpj   :jpj+jprj) = pt2d ( :, 2         :2+jprj) 
    554       ELSE                                   !* closed 
    555          IF( .NOT. cd_type == 'F' )   pt2d(:,  1-jprj   :  jprecj  ) = 0._wp     ! south except at F-point 
    556                                       pt2d(:,nlcj-jprecj+1:jpj+jprj) = 0._wp     ! north 
    557       ENDIF 
    558       !                                !== East-West boundaries 
    559       !                                      !* Cyclic east-west 
    560       IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 
    561          pt2d(1-jpri:     1    ,:) = pt2d(jpim1-jpri:  jpim1 ,:)              ! east 
    562          pt2d(   jpi  :jpi+jpri,:) = pt2d(     2      :2+jpri,:)              ! west 
    563       ELSE                                   !* closed 
    564          IF( .NOT. cd_type == 'F' )   pt2d(  1-jpri   :jpreci    ,:) = 0._wp  ! south except at F-point 
    565                                       pt2d(nlci-jpreci+1:jpi+jpri,:) = 0._wp  ! north 
    566       ENDIF 
    567       ! 
    568       ! north fold treatment 
    569       ! -------------------- 
    570       IF( npolj /= 0 ) THEN 
    571          ! 
    572          SELECT CASE ( jpni ) 
    573 !!gm ERROR        CASE ( 1 )     ;   CALL lbc_nfd        ( pt2d(1:jpi,1:jpj+jprj), cd_type, psgn, pr2dj=jprj ) 
    574 !!gm ERROR         CASE DEFAULT   ;   CALL mpp_lbc_north_e( pt2d                  , cd_type, psgn             ) 
    575          END SELECT 
    576          ! 
    577       ENDIF 
    578  
    579       ! 2. East and west directions exchange 
    580       ! ------------------------------------ 
    581       ! we play with the neigbours AND the row number because of the periodicity 
    582       ! 
    583       SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
    584       CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case) 
    585          iihom = nlci-nreci-jpri 
    586          DO jl = 1, ipreci 
    587             r2dew(:,jl,1) = pt2d(jpreci+jl,:) 
    588             r2dwe(:,jl,1) = pt2d(iihom +jl,:) 
    589          END DO 
    590       END SELECT 
    591       ! 
    592       !                           ! Migrations 
    593       imigr = ipreci * ( jpj + 2*jprj) 
    594       ! 
    595       SELECT CASE ( nbondi ) 
    596       CASE ( -1 ) 
    597          CALL mppsend( 2, r2dwe(1-jprj,1,1), imigr, noea, ml_req1 ) 
    598          CALL mpprecv( 1, r2dew(1-jprj,1,2), imigr, noea ) 
    599          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    600       CASE ( 0 ) 
    601          CALL mppsend( 1, r2dew(1-jprj,1,1), imigr, nowe, ml_req1 ) 
    602          CALL mppsend( 2, r2dwe(1-jprj,1,1), imigr, noea, ml_req2 ) 
    603          CALL mpprecv( 1, r2dew(1-jprj,1,2), imigr, noea ) 
    604          CALL mpprecv( 2, r2dwe(1-jprj,1,2), imigr, nowe ) 
    605          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    606          IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 
    607       CASE ( 1 ) 
    608          CALL mppsend( 1, r2dew(1-jprj,1,1), imigr, nowe, ml_req1 ) 
    609          CALL mpprecv( 2, r2dwe(1-jprj,1,2), imigr, nowe ) 
    610          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    611       END SELECT 
    612       ! 
    613       !                           ! Write Dirichlet lateral conditions 
    614       iihom = nlci - jpreci 
    615       ! 
    616       SELECT CASE ( nbondi ) 
    617       CASE ( -1 ) 
    618          DO jl = 1, ipreci 
    619             pt2d(iihom+jl,:) = r2dew(:,jl,2) 
    620          END DO 
    621       CASE ( 0 ) 
    622          DO jl = 1, ipreci 
    623             pt2d(jl-jpri,:) = r2dwe(:,jl,2) 
    624             pt2d( iihom+jl,:) = r2dew(:,jl,2) 
    625          END DO 
    626       CASE ( 1 ) 
    627          DO jl = 1, ipreci 
    628             pt2d(jl-jpri,:) = r2dwe(:,jl,2) 
    629          END DO 
    630       END SELECT 
    631  
    632       ! 3. North and south directions 
    633       ! ----------------------------- 
    634       ! always closed : we play only with the neigbours 
    635       ! 
    636       IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions 
    637          ijhom = nlcj-nrecj-jprj 
    638          DO jl = 1, iprecj 
    639             r2dsn(:,jl,1) = pt2d(:,ijhom +jl) 
    640             r2dns(:,jl,1) = pt2d(:,jprecj+jl) 
    641          END DO 
    642       ENDIF 
    643       ! 
    644       !                           ! Migrations 
    645       imigr = iprecj * ( jpi + 2*jpri ) 
    646       ! 
    647       SELECT CASE ( nbondj ) 
    648       CASE ( -1 ) 
    649          CALL mppsend( 4, r2dsn(1-jpri,1,1), imigr, nono, ml_req1 ) 
    650          CALL mpprecv( 3, r2dns(1-jpri,1,2), imigr, nono ) 
    651          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    652       CASE ( 0 ) 
    653          CALL mppsend( 3, r2dns(1-jpri,1,1), imigr, noso, ml_req1 ) 
    654          CALL mppsend( 4, r2dsn(1-jpri,1,1), imigr, nono, ml_req2 ) 
    655          CALL mpprecv( 3, r2dns(1-jpri,1,2), imigr, nono ) 
    656          CALL mpprecv( 4, r2dsn(1-jpri,1,2), imigr, noso ) 
    657          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    658          IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 
    659       CASE ( 1 ) 
    660          CALL mppsend( 3, r2dns(1-jpri,1,1), imigr, noso, ml_req1 ) 
    661          CALL mpprecv( 4, r2dsn(1-jpri,1,2), imigr, noso ) 
    662          IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    663       END SELECT 
    664       ! 
    665       !                           ! Write Dirichlet lateral conditions 
    666       ijhom = nlcj - jprecj 
    667       ! 
    668       SELECT CASE ( nbondj ) 
    669       CASE ( -1 ) 
    670          DO jl = 1, iprecj 
    671             pt2d(:,ijhom+jl) = r2dns(:,jl,2) 
    672          END DO 
    673       CASE ( 0 ) 
    674          DO jl = 1, iprecj 
    675             pt2d(:,jl-jprj) = r2dsn(:,jl,2) 
    676             pt2d(:,ijhom+jl ) = r2dns(:,jl,2) 
    677          END DO 
    678       CASE ( 1 ) 
    679          DO jl = 1, iprecj 
    680             pt2d(:,jl-jprj) = r2dsn(:,jl,2) 
    681          END DO 
    682       END SELECT 
    683       ! 
    684    END SUBROUTINE mpp_lnk_2d_e 
    685475 
    686476 
     
    14581248 
    14591249 
    1460    SUBROUTINE mpp_lbc_north_e( pt2d, cd_type, psgn) 
    1461       !!--------------------------------------------------------------------- 
    1462       !!                   ***  routine mpp_lbc_north_2d  *** 
    1463       !! 
    1464       !! ** Purpose :   Ensure proper north fold horizontal bondary condition 
    1465       !!              in mpp configuration in case of jpn1 > 1 and for 2d 
    1466       !!              array with outer extra halo 
    1467       !! 
    1468       !! ** Method  :   North fold condition and mpp with more than one proc 
    1469       !!              in i-direction require a specific treatment. We gather 
    1470       !!              the 4+2*jpr2dj northern lines of the global domain on 1 
    1471       !!              processor and apply lbc north-fold on this sub array. 
    1472       !!              Then we scatter the north fold array back to the processors. 
    1473       !! 
    1474       !!---------------------------------------------------------------------- 
    1475       REAL(wp), DIMENSION(1-jpr2di:jpi+jpr2di,1-jpr2dj:jpj+jpr2dj), INTENT(inout) ::   pt2d     ! 2D array with extra halo 
    1476       CHARACTER(len=1)                                            , INTENT(in   ) ::   cd_type  ! nature of pt3d grid-points 
    1477       REAL(wp)                                                    , INTENT(in   ) ::   psgn     ! sign used across the north fold 
    1478       ! 
    1479       INTEGER ::   ji, jj, jr 
    1480       INTEGER ::   ierr, itaille, ildi, ilei, iilb 
    1481       INTEGER ::   ijpj, ij, iproc 
    1482       REAL(wp), DIMENSION(:,:)  , ALLOCATABLE  ::  ztab_e, znorthloc_e 
    1483       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE  ::  znorthgloio_e 
    1484       !!---------------------------------------------------------------------- 
    1485       ! 
    1486       ALLOCATE( ztab_e(jpiglo,4+2*jpr2dj), znorthloc_e(jpi,4+2*jpr2dj), znorthgloio_e(jpi,4+2*jpr2dj,jpni) ) 
    1487       ! 
    1488       ijpj=4 
    1489       ztab_e(:,:) = 0._wp 
    1490  
    1491       ij = 0 
    1492       ! put in znorthloc_e the last 4 jlines of pt2d 
    1493       DO jj = nlcj - ijpj + 1 - jpr2dj, nlcj +jpr2dj 
    1494          ij = ij + 1 
    1495          DO ji = 1, jpi 
    1496             znorthloc_e(ji,ij) = pt2d(ji,jj) 
    1497          END DO 
    1498       END DO 
    1499       ! 
    1500       itaille = jpi * ( ijpj + 2 * jpr2dj ) 
    1501       CALL MPI_ALLGATHER( znorthloc_e(1,1)    , itaille, MPI_DOUBLE_PRECISION,    & 
    1502          &                znorthgloio_e(1,1,1), itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 
    1503       ! 
    1504       DO jr = 1, ndim_rank_north            ! recover the global north array 
    1505          iproc = nrank_north(jr) + 1 
    1506          ildi  = nldit (iproc) 
    1507          ilei  = nleit (iproc) 
    1508          iilb  = nimppt(iproc) 
    1509          DO jj = 1, ijpj+2*jpr2dj 
    1510             DO ji = ildi, ilei 
    1511                ztab_e(ji+iilb-1,jj) = znorthgloio_e(ji,jj,jr) 
    1512             END DO 
    1513          END DO 
    1514       END DO 
    1515  
    1516       ! 2. North-Fold boundary conditions 
    1517       ! ---------------------------------- 
    1518 !!gm ERROR      CALL lbc_nfd( ztab_e(:,:), cd_type, psgn, pr2dj = jpr2dj ) 
    1519  
    1520       ij = jpr2dj 
    1521       !! Scatter back to pt2d 
    1522       DO jj = nlcj - ijpj + 1 , nlcj +jpr2dj 
    1523       ij  = ij +1 
    1524          DO ji= 1, nlci 
    1525             pt2d(ji,jj) = ztab_e(ji+nimpp-1,ij) 
    1526          END DO 
    1527       END DO 
    1528       ! 
    1529       DEALLOCATE( ztab_e, znorthloc_e, znorthgloio_e ) 
    1530       ! 
    1531    END SUBROUTINE mpp_lbc_north_e 
    1532  
    1533  
    15341250   SUBROUTINE mpi_init_opa( ldtxt, ksft, code ) 
    15351251      !!--------------------------------------------------------------------- 
     
    16231339 
    16241340 
    1625    SUBROUTINE mpp_lbc_north_icb( pt2d, cd_type, psgn, pr2dj) 
     1341   SUBROUTINE mpp_lbc_north_icb( pt2d, cd_type, psgn, kextj) 
    16261342      !!--------------------------------------------------------------------- 
    16271343      !!                   ***  routine mpp_lbc_north_icb  *** 
     
    16331349      !! ** Method  :   North fold condition and mpp with more than one proc 
    16341350      !!              in i-direction require a specific treatment. We gather 
    1635       !!              the 4+2*jpr2dj northern lines of the global domain on 1 
     1351      !!              the 4+kextj northern lines of the global domain on 1 
    16361352      !!              processor and apply lbc north-fold on this sub array. 
    16371353      !!              Then we scatter the north fold array back to the processors. 
    1638       !!              This version accounts for an extra halo with icebergs. 
     1354      !!              This routine accounts for an extra halo with icebergs 
     1355      !!              and assumes ghost rows and columns have been suppressed. 
    16391356      !! 
    16401357      !!---------------------------------------------------------------------- 
     
    16441361      REAL(wp)                , INTENT(in   ) ::   psgn     ! = -1. the sign change across the 
    16451362      !!                                                    ! north fold, =  1. otherwise 
    1646       INTEGER, OPTIONAL       , INTENT(in   ) ::   pr2dj 
     1363      INTEGER                 , INTENT(in   ) ::   kextj    ! Extra halo width at north fold 
    16471364      ! 
    16481365      INTEGER ::   ji, jj, jr 
    16491366      INTEGER ::   ierr, itaille, ildi, ilei, iilb 
    1650       INTEGER ::   ijpj, ij, iproc, ipr2dj 
     1367      INTEGER ::   ipj, ij, iproc 
    16511368      ! 
    16521369      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE  ::  ztab_e, znorthloc_e 
     
    16541371      !!---------------------------------------------------------------------- 
    16551372      ! 
    1656       ijpj=4 
    1657       IF( PRESENT(pr2dj) ) THEN           ! use of additional halos 
    1658          ipr2dj = pr2dj 
    1659       ELSE 
    1660          ipr2dj = 0 
    1661       ENDIF 
    1662       ALLOCATE( ztab_e(jpiglo,4+2*ipr2dj), znorthloc_e(jpi,4+2*ipr2dj), znorthgloio_e(jpi,4+2*ipr2dj,jpni) ) 
    1663       ! 
    1664       ztab_e(:,:) = 0._wp 
     1373      ipj=4 
     1374      ALLOCATE( ztab_e(jpiglo,ipj+kextj), znorthloc_e(  jpimax,ipj+kextj), & 
     1375     &                                    znorthgloio_e(jpimax,ipj+kextj,jpni) ) 
     1376      ! 
     1377      ztab_e(:,:)      = 0._wp 
     1378      znorthloc_e(:,:) = 0._wp 
    16651379      ! 
    16661380      ij = 0 
    1667       ! put in znorthloc_e the last 4 jlines of pt2d 
    1668       DO jj = nlcj - ijpj + 1 - ipr2dj, nlcj +ipr2dj 
     1381      ! put the last ipj+kextj lines of pt2d into znorthloc_e  
     1382      DO jj = jpj - ipj + 1, jpj + kextj 
    16691383         ij = ij + 1 
    1670          DO ji = 1, jpi 
    1671             znorthloc_e(ji,ij)=pt2d(ji,jj) 
    1672          END DO 
     1384         znorthloc_e(1:jpi,ij)=pt2d(1:jpi,jj) 
    16731385      END DO 
    16741386      ! 
    1675       itaille = jpi * ( ijpj + 2 * ipr2dj ) 
     1387      itaille = jpimax * ( ipj + kextj ) 
    16761388      CALL MPI_ALLGATHER( znorthloc_e(1,1)  , itaille, MPI_DOUBLE_PRECISION,    & 
    16771389         &                znorthgloio_e(1,1,1), itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 
     
    16821394         ilei = nleit (iproc) 
    16831395         iilb = nimppt(iproc) 
    1684          DO jj = 1, ijpj+2*ipr2dj 
     1396         DO jj = 1, ipj+kextj 
    16851397            DO ji = ildi, ilei 
    16861398               ztab_e(ji+iilb-1,jj) = znorthgloio_e(ji,jj,jr) 
     
    16911403      ! 2. North-Fold boundary conditions 
    16921404      ! ---------------------------------- 
    1693 !!gm ERROR      CALL lbc_nfd( ztab_e(:,:), cd_type, psgn, pr2dj = ipr2dj ) 
    1694  
    1695       ij = ipr2dj 
     1405      CALL lbc_nfd( ztab_e(:,:), cd_type, psgn, kextj ) 
     1406 
     1407      ij = 0 
    16961408      !! Scatter back to pt2d 
    1697       DO jj = nlcj - ijpj + 1 , nlcj +ipr2dj 
     1409      DO jj = jpj - ipj + 1 , jpj + kextj 
    16981410      ij  = ij +1 
    1699          DO ji= 1, nlci 
     1411         DO ji= 1, jpi 
    17001412            pt2d(ji,jj) = ztab_e(ji+nimpp-1,ij) 
    17011413         END DO 
     
    17071419 
    17081420 
    1709    SUBROUTINE mpp_lnk_2d_icb( pt2d, cd_type, psgn, jpri, jprj ) 
     1421   SUBROUTINE mpp_lnk_2d_icb( pt2d, cd_type, psgn, kexti, kextj ) 
    17101422      !!---------------------------------------------------------------------- 
    17111423      !!                  ***  routine mpp_lnk_2d_icb  *** 
    17121424      !! 
    1713       !! ** Purpose :   Message passing manadgement for 2d array (with extra halo and icebergs) 
     1425      !! ** Purpose :   Message passing management for 2d array (with extra halo for icebergs) 
     1426      !!                This routine receives a (1-kexti:jpi+kexti,1-kexti:jpj+kextj) 
     1427      !!                array (usually (0:jpi+1, 0:jpj+1)) from lbc_lnk_icb calls. 
    17141428      !! 
    17151429      !! ** Method  :   Use mppsend and mpprecv function for passing mask 
    17161430      !!      between processors following neighboring subdomains. 
    17171431      !!            domain parameters 
    1718       !!                    nlci   : first dimension of the local subdomain 
    1719       !!                    nlcj   : second dimension of the local subdomain 
    1720       !!                    jpri   : number of rows for extra outer halo 
    1721       !!                    jprj   : number of columns for extra outer halo 
     1432      !!                    jpi    : first dimension of the local subdomain 
     1433      !!                    jpj    : second dimension of the local subdomain 
     1434      !!                    kexti  : number of columns for extra outer halo 
     1435      !!                    kextj  : number of rows for extra outer halo 
    17221436      !!                    nbondi : mark for "east-west local boundary" 
    17231437      !!                    nbondj : mark for "north-south local boundary" 
     
    17271441      !!                    nono   : number for local neighboring processors 
    17281442      !!---------------------------------------------------------------------- 
    1729       REAL(wp), DIMENSION(1-jpri:jpi+jpri,1-jprj:jpj+jprj), INTENT(inout) ::   pt2d     ! 2D array with extra halo 
    1730       CHARACTER(len=1)                                    , INTENT(in   ) ::   cd_type  ! nature of ptab array grid-points 
    1731       REAL(wp)                                            , INTENT(in   ) ::   psgn     ! sign used across the north fold 
    1732       INTEGER                                             , INTENT(in   ) ::   jpri 
    1733       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 
    17341448      ! 
    17351449      INTEGER  ::   jl   ! dummy loop indices 
     
    17391453      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend 
    17401454      !! 
    1741       REAL(wp), DIMENSION(1-jpri:jpi+jpri,jprecj+jprj,2) ::   r2dns, r2dsn 
    1742       REAL(wp), DIMENSION(1-jprj:jpj+jprj,jpreci+jpri,2) ::   r2dwe, r2dew 
    1743       !!---------------------------------------------------------------------- 
    1744  
    1745       ipreci = jpreci + jpri      ! take into account outer extra 2D overlap area 
    1746       iprecj = jprecj + 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 
    17471461 
    17481462 
     
    17541468      !                                           !* Cyclic east-west 
    17551469      IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 
    1756          pt2d(1-jpri:     1    ,:) = pt2d(jpim1-jpri:  jpim1 ,:)       ! east 
    1757          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 
    17581472         ! 
    17591473      ELSE                                        !* closed 
    1760          IF( .NOT. cd_type == 'F' )   pt2d(  1-jpri   :jpreci    ,:) = 0._wp    ! south except at F-point 
    1761                                       pt2d(nlci-jpreci+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 
    17621476      ENDIF 
    17631477      ! 
     
    17681482         ! 
    17691483         SELECT CASE ( jpni ) 
    1770 !!gm ERROR         CASE ( 1 )     ;   CALL lbc_nfd        ( pt2d(1:jpi,1:jpj+jprj), cd_type, psgn, pr2dj=jprj ) 
    1771 !!gm ERROR         CASE DEFAULT   ;   CALL mpp_lbc_north_icb( pt2d(1:jpi,1:jpj+jprj)  , cd_type, psgn , pr2dj=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 ) 
    17721486         END SELECT 
    17731487         ! 
     
    17801494      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
    17811495      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case) 
    1782          iihom = nlci-nreci-jpri 
     1496         iihom = jpi-nreci-kexti 
    17831497         DO jl = 1, ipreci 
    1784             r2dew(:,jl,1) = pt2d(jpreci+jl,:) 
     1498            r2dew(:,jl,1) = pt2d(nn_hls+jl,:) 
    17851499            r2dwe(:,jl,1) = pt2d(iihom +jl,:) 
    17861500         END DO 
     
    17881502      ! 
    17891503      !                           ! Migrations 
    1790       imigr = ipreci * ( jpj + 2*jprj) 
     1504      imigr = ipreci * ( jpj + 2*kextj ) 
    17911505      ! 
    17921506      SELECT CASE ( nbondi ) 
    17931507      CASE ( -1 ) 
    1794          CALL mppsend( 2, r2dwe(1-jprj,1,1), imigr, noea, ml_req1 ) 
    1795          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 ) 
    17961510         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    17971511      CASE ( 0 ) 
    1798          CALL mppsend( 1, r2dew(1-jprj,1,1), imigr, nowe, ml_req1 ) 
    1799          CALL mppsend( 2, r2dwe(1-jprj,1,1), imigr, noea, ml_req2 ) 
    1800          CALL mpprecv( 1, r2dew(1-jprj,1,2), imigr, noea ) 
    1801          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 ) 
    18021516         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    18031517         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 
    18041518      CASE ( 1 ) 
    1805          CALL mppsend( 1, r2dew(1-jprj,1,1), imigr, nowe, ml_req1 ) 
    1806          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 ) 
    18071521         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    18081522      END SELECT 
    18091523      ! 
    18101524      !                           ! Write Dirichlet lateral conditions 
    1811       iihom = nlci - jpreci 
     1525      iihom = jpi - nn_hls 
    18121526      ! 
    18131527      SELECT CASE ( nbondi ) 
     
    18181532      CASE ( 0 ) 
    18191533         DO jl = 1, ipreci 
    1820             pt2d(jl-jpri,:) = r2dwe(:,jl,2) 
    1821             pt2d( iihom+jl,:) = r2dew(:,jl,2) 
     1534            pt2d(jl-kexti,:) = r2dwe(:,jl,2) 
     1535            pt2d(iihom+jl,:) = r2dew(:,jl,2) 
    18221536         END DO 
    18231537      CASE ( 1 ) 
    18241538         DO jl = 1, ipreci 
    1825             pt2d(jl-jpri,:) = r2dwe(:,jl,2) 
     1539            pt2d(jl-kexti,:) = r2dwe(:,jl,2) 
    18261540         END DO 
    18271541      END SELECT 
     
    18331547      ! 
    18341548      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions 
    1835          ijhom = nlcj-nrecj-jprj 
     1549         ijhom = jpj-nrecj-kextj 
    18361550         DO jl = 1, iprecj 
    18371551            r2dsn(:,jl,1) = pt2d(:,ijhom +jl) 
    1838             r2dns(:,jl,1) = pt2d(:,jprecj+jl) 
     1552            r2dns(:,jl,1) = pt2d(:,nn_hls+jl) 
    18391553         END DO 
    18401554      ENDIF 
    18411555      ! 
    18421556      !                           ! Migrations 
    1843       imigr = iprecj * ( jpi + 2*jpri ) 
     1557      imigr = iprecj * ( jpi + 2*kexti ) 
    18441558      ! 
    18451559      SELECT CASE ( nbondj ) 
    18461560      CASE ( -1 ) 
    1847          CALL mppsend( 4, r2dsn(1-jpri,1,1), imigr, nono, ml_req1 ) 
    1848          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 ) 
    18491563         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    18501564      CASE ( 0 ) 
    1851          CALL mppsend( 3, r2dns(1-jpri,1,1), imigr, noso, ml_req1 ) 
    1852          CALL mppsend( 4, r2dsn(1-jpri,1,1), imigr, nono, ml_req2 ) 
    1853          CALL mpprecv( 3, r2dns(1-jpri,1,2), imigr, nono ) 
    1854          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 ) 
    18551569         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    18561570         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 
    18571571      CASE ( 1 ) 
    1858          CALL mppsend( 3, r2dns(1-jpri,1,1), imigr, noso, ml_req1 ) 
    1859          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 ) 
    18601574         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
    18611575      END SELECT 
    18621576      ! 
    18631577      !                           ! Write Dirichlet lateral conditions 
    1864       ijhom = nlcj - jprecj 
     1578      ijhom = jpj - nn_hls 
    18651579      ! 
    18661580      SELECT CASE ( nbondj ) 
     
    18711585      CASE ( 0 ) 
    18721586         DO jl = 1, iprecj 
    1873             pt2d(:,jl-jprj) = r2dsn(:,jl,2) 
    1874             pt2d(:,ijhom+jl ) = r2dns(:,jl,2) 
     1587            pt2d(:,jl-kextj) = r2dsn(:,jl,2) 
     1588            pt2d(:,ijhom+jl) = r2dns(:,jl,2) 
    18751589         END DO 
    18761590      CASE ( 1 ) 
    18771591         DO jl = 1, iprecj 
    1878             pt2d(:,jl-jprj) = r2dsn(:,jl,2) 
     1592            pt2d(:,jl-kextj) = r2dsn(:,jl,2) 
    18791593         END DO 
    18801594      END SELECT 
Note: See TracChangeset for help on using the changeset viewer.