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 5260 for branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90 – NEMO

Ignore:
Timestamp:
2015-05-12T12:37:15+02:00 (9 years ago)
Author:
deazer
Message:

Merged branch with Trunk at revision 5253.
Checked with SETTE, passes modified iodef.xml for AMM12 experiment

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4650_UKMO10_Tidally_Meaned_Diagnostics/NEMOGCM/NEMO/OPA_SRC/LBC/lib_mpp.F90

    r4645 r5260  
    4242   !!   mpp_lnk_3d_gather :  Message passing manadgement for two 3D arrays 
    4343   !!   mpp_lnk_e     : interface (defined in lbclnk) for message passing of 2d array with extra halo (mpp_lnk_2d_e) 
     44   !!   mpp_lnk_icb   : interface for message passing of 2d arrays with extra halo for icebergs (mpp_lnk_2d_icb) 
    4445   !!   mpprecv         : 
    4546   !!   mppsend       :   SUBROUTINE mpp_ini_znl 
     
    5657   !!   mpp_lbc_north : north fold processors gathering 
    5758   !!   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 
    5860   !!---------------------------------------------------------------------- 
    5961   USE dom_oce        ! ocean space and time domain 
     
    7476   PUBLIC   mppsend, mpprecv                          ! needed by TAM and ICB routines 
    7577   PUBLIC   mpp_lnk_bdy_2d, mpp_lnk_bdy_3d 
     78   PUBLIC   mpp_lbc_north_icb, mpp_lnk_2d_icb 
    7679 
    7780   !! * Interfaces 
     
    20262029      ijpjm1 = 3 
    20272030      ! 
     2031      znorthloc(:,:,:) = 0 
    20282032      DO jk = 1, jpk 
    20292033         DO jj = nlcj - ijpj +1, nlcj          ! put in xnorthloc the last 4 jlines of pt3d 
     
    20362040      itaille = jpi * jpk * ijpj 
    20372041 
    2038  
    20392042      IF ( l_north_nogather ) THEN 
    20402043         ! 
    20412044        ztabr(:,:,:) = 0 
     2045        ztabl(:,:,:) = 0 
     2046 
    20422047        DO jk = 1, jpk 
    20432048           DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array 
    20442049              ij = jj - nlcj + ijpj 
    2045               DO ji = 1, nlci 
     2050              DO ji = nfsloop, nfeloop 
    20462051                 ztabl(ji,ij,jk) = pt3d(ji,jj,jk) 
    20472052              END DO 
     
    20502055 
    20512056         DO jr = 1,nsndto 
    2052             IF (isendto(jr) .ne. narea) CALL mppsend( 5, znorthloc, itaille, isendto(jr)-1, ml_req_nf(jr) ) 
     2057            IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 
     2058              CALL mppsend( 5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr) ) 
     2059            ENDIF 
    20532060         END DO 
    20542061         DO jr = 1,nsndto 
    2055             iproc = isendto(jr) 
    2056             ildi = nldit (iproc) 
    2057             ilei = nleit (iproc) 
    2058             iilb = nimppt(isendto(jr)) - nimppt(isendto(1)) 
    2059             IF(isendto(jr) .ne. narea) THEN 
    2060               CALL mpprecv(5, zfoldwk, itaille, isendto(jr)-1) 
     2062            iproc = nfipproc(isendto(jr),jpnj) 
     2063            IF(iproc .ne. -1) THEN 
     2064               ilei = nleit (iproc+1) 
     2065               ildi = nldit (iproc+1) 
     2066               iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj) 
     2067            ENDIF 
     2068            IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN 
     2069              CALL mpprecv(5, zfoldwk, itaille, iproc) 
    20612070              DO jk = 1, jpk 
    20622071                 DO jj = 1, ijpj 
    2063                     DO ji = 1, ilei 
     2072                    DO ji = ildi, ilei 
    20642073                       ztabr(iilb+ji,jj,jk) = zfoldwk(ji,jj,jk) 
    20652074                    END DO 
    20662075                 END DO 
    20672076              END DO 
    2068            ELSE 
     2077           ELSE IF (iproc .eq. (narea-1)) THEN 
    20692078              DO jk = 1, jpk 
    20702079                 DO jj = 1, ijpj 
    2071                     DO ji = 1, ilei 
     2080                    DO ji = ildi, ilei 
    20722081                       ztabr(iilb+ji,jj,jk) = pt3d(ji,nlcj-ijpj+jj,jk) 
    20732082                    END DO 
     
    20782087         IF (l_isend) THEN 
    20792088            DO jr = 1,nsndto 
    2080                IF (isendto(jr) .ne. narea) CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 
     2089               IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 
     2090                  CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 
     2091               ENDIF     
    20812092            END DO 
    20822093         ENDIF 
    20832094         CALL mpp_lbc_nfd( ztabl, ztabr, cd_type, psgn )   ! North fold boundary condition 
    2084          ! 
    20852095         DO jk = 1, jpk 
    20862096            DO jj = nlcj-ijpj+1, nlcj             ! Scatter back to pt3d 
     
    21902200         ! 
    21912201         ztabr(:,:) = 0 
     2202         ztabl(:,:) = 0 
     2203 
    21922204         DO jj = nlcj-ijpj+1, nlcj          ! First put local values into the global array 
    21932205            ij = jj - nlcj + ijpj 
    2194             DO ji = 1, nlci 
     2206              DO ji = nfsloop, nfeloop 
    21952207               ztabl(ji,ij) = pt2d(ji,jj) 
    21962208            END DO 
     
    21982210 
    21992211         DO jr = 1,nsndto 
    2200             IF (isendto(jr) .ne. narea) CALL mppsend(5, znorthloc, itaille, isendto(jr)-1, ml_req_nf(jr)) 
     2212            IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 
     2213               CALL mppsend(5, znorthloc, itaille, nfipproc(isendto(jr),jpnj), ml_req_nf(jr)) 
     2214            ENDIF 
    22012215         END DO 
    22022216         DO jr = 1,nsndto 
    2203             iproc = isendto(jr) 
    2204             ildi = nldit (iproc) 
    2205             ilei = nleit (iproc) 
    2206             iilb = nimppt(isendto(jr)) - nimppt(isendto(1)) 
    2207             IF(isendto(jr) .ne. narea) THEN 
    2208               CALL mpprecv(5, zfoldwk, itaille, isendto(jr)-1) 
     2217            iproc = nfipproc(isendto(jr),jpnj) 
     2218            IF(iproc .ne. -1) THEN 
     2219               ilei = nleit (iproc+1) 
     2220               ildi = nldit (iproc+1) 
     2221               iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj) 
     2222            ENDIF 
     2223            IF((iproc .ne. (narea-1)) .and. (iproc .ne. -1)) THEN 
     2224              CALL mpprecv(5, zfoldwk, itaille, iproc) 
    22092225              DO jj = 1, ijpj 
    2210                  DO ji = 1, ilei 
     2226                 DO ji = ildi, ilei 
    22112227                    ztabr(iilb+ji,jj) = zfoldwk(ji,jj) 
    22122228                 END DO 
    22132229              END DO 
    2214             ELSE 
     2230            ELSE IF (iproc .eq. (narea-1)) THEN 
    22152231              DO jj = 1, ijpj 
    2216                  DO ji = 1, ilei 
     2232                 DO ji = ildi, ilei 
    22172233                    ztabr(iilb+ji,jj) = pt2d(ji,nlcj-ijpj+jj) 
    22182234                 END DO 
     
    22222238         IF (l_isend) THEN 
    22232239            DO jr = 1,nsndto 
    2224                IF (isendto(jr) .ne. narea) CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 
     2240               IF ((nfipproc(isendto(jr),jpnj) .ne. (narea-1)) .and. (nfipproc(isendto(jr),jpnj) .ne. -1)) THEN 
     2241                  CALL mpi_wait(ml_req_nf(jr), ml_stat, ml_err) 
     2242               ENDIF 
    22252243            END DO 
    22262244         ENDIF 
     
    28782896   END SUBROUTINE DDPDD_MPI 
    28792897 
     2898   SUBROUTINE mpp_lbc_north_icb( pt2d, cd_type, psgn, pr2dj) 
     2899      !!--------------------------------------------------------------------- 
     2900      !!                   ***  routine mpp_lbc_north_icb  *** 
     2901      !! 
     2902      !! ** Purpose :   Ensure proper north fold horizontal bondary condition 
     2903      !!              in mpp configuration in case of jpn1 > 1 and for 2d 
     2904      !!              array with outer extra halo 
     2905      !! 
     2906      !! ** Method  :   North fold condition and mpp with more than one proc 
     2907      !!              in i-direction require a specific treatment. We gather 
     2908      !!              the 4+2*jpr2dj northern lines of the global domain on 1 
     2909      !!              processor and apply lbc north-fold on this sub array. 
     2910      !!              Then we scatter the north fold array back to the processors. 
     2911      !!              This version accounts for an extra halo with icebergs. 
     2912      !! 
     2913      !!---------------------------------------------------------------------- 
     2914      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pt2d     ! 2D array with extra halo 
     2915      CHARACTER(len=1)        , INTENT(in   ) ::   cd_type  ! nature of pt3d grid-points 
     2916      !                                                     !   = T ,  U , V , F or W -points 
     2917      REAL(wp)                , INTENT(in   ) ::   psgn     ! = -1. the sign change across the 
     2918      !!                                                    ! north fold, =  1. otherwise 
     2919      INTEGER, OPTIONAL       , INTENT(in   ) ::   pr2dj 
     2920      INTEGER ::   ji, jj, jr 
     2921      INTEGER ::   ierr, itaille, ildi, ilei, iilb 
     2922      INTEGER ::   ijpj, ij, iproc, ipr2dj 
     2923      ! 
     2924      REAL(wp), DIMENSION(:,:)  , ALLOCATABLE  ::  ztab_e, znorthloc_e 
     2925      REAL(wp), DIMENSION(:,:,:), ALLOCATABLE  ::  znorthgloio_e 
     2926 
     2927      !!---------------------------------------------------------------------- 
     2928      ! 
     2929      ijpj=4 
     2930      IF( PRESENT(pr2dj) ) THEN           ! use of additional halos 
     2931         ipr2dj = pr2dj 
     2932      ELSE 
     2933         ipr2dj = 0 
     2934      ENDIF 
     2935      ALLOCATE( ztab_e(jpiglo,4+2*ipr2dj), znorthloc_e(jpi,4+2*ipr2dj), znorthgloio_e(jpi,4+2*ipr2dj,jpni) ) 
     2936 
     2937      ! 
     2938      ztab_e(:,:) = 0.e0 
     2939 
     2940      ij=0 
     2941      ! put in znorthloc_e the last 4 jlines of pt2d 
     2942      DO jj = nlcj - ijpj + 1 - ipr2dj, nlcj +ipr2dj 
     2943         ij = ij + 1 
     2944         DO ji = 1, jpi 
     2945            znorthloc_e(ji,ij)=pt2d(ji,jj) 
     2946         END DO 
     2947      END DO 
     2948      ! 
     2949      itaille = jpi * ( ijpj + 2 * ipr2dj ) 
     2950      CALL MPI_ALLGATHER( znorthloc_e(1,1)  , itaille, MPI_DOUBLE_PRECISION,    & 
     2951         &                znorthgloio_e(1,1,1), itaille, MPI_DOUBLE_PRECISION, ncomm_north, ierr ) 
     2952      ! 
     2953      DO jr = 1, ndim_rank_north            ! recover the global north array 
     2954         iproc = nrank_north(jr) + 1 
     2955         ildi = nldit (iproc) 
     2956         ilei = nleit (iproc) 
     2957         iilb = nimppt(iproc) 
     2958         DO jj = 1, ijpj+2*ipr2dj 
     2959            DO ji = ildi, ilei 
     2960               ztab_e(ji+iilb-1,jj) = znorthgloio_e(ji,jj,jr) 
     2961            END DO 
     2962         END DO 
     2963      END DO 
     2964 
     2965 
     2966      ! 2. North-Fold boundary conditions 
     2967      ! ---------------------------------- 
     2968      CALL lbc_nfd( ztab_e(:,:), cd_type, psgn, pr2dj = ipr2dj ) 
     2969 
     2970      ij = ipr2dj 
     2971      !! Scatter back to pt2d 
     2972      DO jj = nlcj - ijpj + 1 , nlcj +ipr2dj 
     2973      ij  = ij +1 
     2974         DO ji= 1, nlci 
     2975            pt2d(ji,jj) = ztab_e(ji+nimpp-1,ij) 
     2976         END DO 
     2977      END DO 
     2978      ! 
     2979      DEALLOCATE( ztab_e, znorthloc_e, znorthgloio_e ) 
     2980      ! 
     2981   END SUBROUTINE mpp_lbc_north_icb 
     2982 
     2983   SUBROUTINE mpp_lnk_2d_icb( pt2d, cd_type, psgn, jpri, jprj ) 
     2984      !!---------------------------------------------------------------------- 
     2985      !!                  ***  routine mpp_lnk_2d_icb  *** 
     2986      !! 
     2987      !! ** Purpose :   Message passing manadgement for 2d array (with extra halo and icebergs) 
     2988      !! 
     2989      !! ** Method  :   Use mppsend and mpprecv function for passing mask 
     2990      !!      between processors following neighboring subdomains. 
     2991      !!            domain parameters 
     2992      !!                    nlci   : first dimension of the local subdomain 
     2993      !!                    nlcj   : second dimension of the local subdomain 
     2994      !!                    jpri   : number of rows for extra outer halo 
     2995      !!                    jprj   : number of columns for extra outer halo 
     2996      !!                    nbondi : mark for "east-west local boundary" 
     2997      !!                    nbondj : mark for "north-south local boundary" 
     2998      !!                    noea   : number for local neighboring processors 
     2999      !!                    nowe   : number for local neighboring processors 
     3000      !!                    noso   : number for local neighboring processors 
     3001      !!                    nono   : number for local neighboring processors 
     3002      !! 
     3003      !!---------------------------------------------------------------------- 
     3004      INTEGER                                             , INTENT(in   ) ::   jpri 
     3005      INTEGER                                             , INTENT(in   ) ::   jprj 
     3006      REAL(wp), DIMENSION(1-jpri:jpi+jpri,1-jprj:jpj+jprj), INTENT(inout) ::   pt2d     ! 2D array with extra halo 
     3007      CHARACTER(len=1)                                    , INTENT(in   ) ::   cd_type  ! nature of ptab array grid-points 
     3008      !                                                                                 ! = T , U , V , F , W and I points 
     3009      REAL(wp)                                            , INTENT(in   ) ::   psgn     ! =-1 the sign change across the 
     3010      !!                                                                                ! north boundary, =  1. otherwise 
     3011      INTEGER  ::   jl   ! dummy loop indices 
     3012      INTEGER  ::   imigr, iihom, ijhom        ! temporary integers 
     3013      INTEGER  ::   ipreci, iprecj             ! temporary integers 
     3014      INTEGER  ::   ml_req1, ml_req2, ml_err   ! for key_mpi_isend 
     3015      INTEGER, DIMENSION(MPI_STATUS_SIZE) ::   ml_stat   ! for key_mpi_isend 
     3016      !! 
     3017      REAL(wp), DIMENSION(1-jpri:jpi+jpri,jprecj+jprj,2) :: r2dns 
     3018      REAL(wp), DIMENSION(1-jpri:jpi+jpri,jprecj+jprj,2) :: r2dsn 
     3019      REAL(wp), DIMENSION(1-jprj:jpj+jprj,jpreci+jpri,2) :: r2dwe 
     3020      REAL(wp), DIMENSION(1-jprj:jpj+jprj,jpreci+jpri,2) :: r2dew 
     3021      !!---------------------------------------------------------------------- 
     3022 
     3023      ipreci = jpreci + jpri      ! take into account outer extra 2D overlap area 
     3024      iprecj = jprecj + jprj 
     3025 
     3026 
     3027      ! 1. standard boundary treatment 
     3028      ! ------------------------------ 
     3029      ! Order matters Here !!!! 
     3030      ! 
     3031      !                                      ! East-West boundaries 
     3032      !                                           !* Cyclic east-west 
     3033      IF( nbondi == 2 .AND. (nperio == 1 .OR. nperio == 4 .OR. nperio == 6) ) THEN 
     3034         pt2d(1-jpri:     1    ,:) = pt2d(jpim1-jpri:  jpim1 ,:)       ! east 
     3035         pt2d(   jpi  :jpi+jpri,:) = pt2d(     2      :2+jpri,:)       ! west 
     3036         ! 
     3037      ELSE                                        !* closed 
     3038         IF( .NOT. cd_type == 'F' )   pt2d(  1-jpri   :jpreci    ,:) = 0.e0    ! south except at F-point 
     3039                                      pt2d(nlci-jpreci+1:jpi+jpri,:) = 0.e0    ! north 
     3040      ENDIF 
     3041      ! 
     3042 
     3043      ! north fold treatment 
     3044      ! ----------------------- 
     3045      IF( npolj /= 0 ) THEN 
     3046         ! 
     3047         SELECT CASE ( jpni ) 
     3048         CASE ( 1 )     ;   CALL lbc_nfd        ( pt2d(1:jpi,1:jpj+jprj), cd_type, psgn, pr2dj=jprj ) 
     3049         CASE DEFAULT   ;   CALL mpp_lbc_north_icb( pt2d(1:jpi,1:jpj+jprj)  , cd_type, psgn , pr2dj=jprj  ) 
     3050         END SELECT 
     3051         ! 
     3052      ENDIF 
     3053 
     3054      ! 2. East and west directions exchange 
     3055      ! ------------------------------------ 
     3056      ! we play with the neigbours AND the row number because of the periodicity 
     3057      ! 
     3058      SELECT CASE ( nbondi )      ! Read Dirichlet lateral conditions 
     3059      CASE ( -1, 0, 1 )                ! all exept 2 (i.e. close case) 
     3060         iihom = nlci-nreci-jpri 
     3061         DO jl = 1, ipreci 
     3062            r2dew(:,jl,1) = pt2d(jpreci+jl,:) 
     3063            r2dwe(:,jl,1) = pt2d(iihom +jl,:) 
     3064         END DO 
     3065      END SELECT 
     3066      ! 
     3067      !                           ! Migrations 
     3068      imigr = ipreci * ( jpj + 2*jprj) 
     3069      ! 
     3070      SELECT CASE ( nbondi ) 
     3071      CASE ( -1 ) 
     3072         CALL mppsend( 2, r2dwe(1-jprj,1,1), imigr, noea, ml_req1 ) 
     3073         CALL mpprecv( 1, r2dew(1-jprj,1,2), imigr, noea ) 
     3074         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
     3075      CASE ( 0 ) 
     3076         CALL mppsend( 1, r2dew(1-jprj,1,1), imigr, nowe, ml_req1 ) 
     3077         CALL mppsend( 2, r2dwe(1-jprj,1,1), imigr, noea, ml_req2 ) 
     3078         CALL mpprecv( 1, r2dew(1-jprj,1,2), imigr, noea ) 
     3079         CALL mpprecv( 2, r2dwe(1-jprj,1,2), imigr, nowe ) 
     3080         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
     3081         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 
     3082      CASE ( 1 ) 
     3083         CALL mppsend( 1, r2dew(1-jprj,1,1), imigr, nowe, ml_req1 ) 
     3084         CALL mpprecv( 2, r2dwe(1-jprj,1,2), imigr, nowe ) 
     3085         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
     3086      END SELECT 
     3087      ! 
     3088      !                           ! Write Dirichlet lateral conditions 
     3089      iihom = nlci - jpreci 
     3090      ! 
     3091      SELECT CASE ( nbondi ) 
     3092      CASE ( -1 ) 
     3093         DO jl = 1, ipreci 
     3094            pt2d(iihom+jl,:) = r2dew(:,jl,2) 
     3095         END DO 
     3096      CASE ( 0 ) 
     3097         DO jl = 1, ipreci 
     3098            pt2d(jl-jpri,:) = r2dwe(:,jl,2) 
     3099            pt2d( iihom+jl,:) = r2dew(:,jl,2) 
     3100         END DO 
     3101      CASE ( 1 ) 
     3102         DO jl = 1, ipreci 
     3103            pt2d(jl-jpri,:) = r2dwe(:,jl,2) 
     3104         END DO 
     3105      END SELECT 
     3106 
     3107 
     3108      ! 3. North and south directions 
     3109      ! ----------------------------- 
     3110      ! always closed : we play only with the neigbours 
     3111      ! 
     3112      IF( nbondj /= 2 ) THEN      ! Read Dirichlet lateral conditions 
     3113         ijhom = nlcj-nrecj-jprj 
     3114         DO jl = 1, iprecj 
     3115            r2dsn(:,jl,1) = pt2d(:,ijhom +jl) 
     3116            r2dns(:,jl,1) = pt2d(:,jprecj+jl) 
     3117         END DO 
     3118      ENDIF 
     3119      ! 
     3120      !                           ! Migrations 
     3121      imigr = iprecj * ( jpi + 2*jpri ) 
     3122      ! 
     3123      SELECT CASE ( nbondj ) 
     3124      CASE ( -1 ) 
     3125         CALL mppsend( 4, r2dsn(1-jpri,1,1), imigr, nono, ml_req1 ) 
     3126         CALL mpprecv( 3, r2dns(1-jpri,1,2), imigr, nono ) 
     3127         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
     3128      CASE ( 0 ) 
     3129         CALL mppsend( 3, r2dns(1-jpri,1,1), imigr, noso, ml_req1 ) 
     3130         CALL mppsend( 4, r2dsn(1-jpri,1,1), imigr, nono, ml_req2 ) 
     3131         CALL mpprecv( 3, r2dns(1-jpri,1,2), imigr, nono ) 
     3132         CALL mpprecv( 4, r2dsn(1-jpri,1,2), imigr, noso ) 
     3133         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
     3134         IF(l_isend) CALL mpi_wait(ml_req2,ml_stat,ml_err) 
     3135      CASE ( 1 ) 
     3136         CALL mppsend( 3, r2dns(1-jpri,1,1), imigr, noso, ml_req1 ) 
     3137         CALL mpprecv( 4, r2dsn(1-jpri,1,2), imigr, noso ) 
     3138         IF(l_isend) CALL mpi_wait(ml_req1,ml_stat,ml_err) 
     3139      END SELECT 
     3140      ! 
     3141      !                           ! Write Dirichlet lateral conditions 
     3142      ijhom = nlcj - jprecj 
     3143      ! 
     3144      SELECT CASE ( nbondj ) 
     3145      CASE ( -1 ) 
     3146         DO jl = 1, iprecj 
     3147            pt2d(:,ijhom+jl) = r2dns(:,jl,2) 
     3148         END DO 
     3149      CASE ( 0 ) 
     3150         DO jl = 1, iprecj 
     3151            pt2d(:,jl-jprj) = r2dsn(:,jl,2) 
     3152            pt2d(:,ijhom+jl ) = r2dns(:,jl,2) 
     3153         END DO 
     3154      CASE ( 1 ) 
     3155         DO jl = 1, iprecj 
     3156            pt2d(:,jl-jprj) = r2dsn(:,jl,2) 
     3157         END DO 
     3158      END SELECT 
     3159 
     3160   END SUBROUTINE mpp_lnk_2d_icb 
    28803161#else 
    28813162   !!---------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.