Ignore:
Timestamp:
2019-10-18T12:52:29+02:00 (12 months ago)
Author:
francesca
Message:

add extra halo support- ticket #2009

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2019/dev_r11514_HPC-02_single-core-extrahalo/src/OCE/LBC/mpp_lnk_generic.h90

    r11692 r11719  
    4646 
    4747#if defined MULTI 
    48    SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, lsend, lrecv, ihlcom ) 
     48   SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn, kfld, kfillmode, pfillval, lsend, lrecv ) 
    4949      INTEGER             , INTENT(in   ) ::   kfld        ! number of pt3d arrays 
    5050#else 
    51    SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn      , kfillmode, pfillval, lsend, lrecv, ihlcom ) 
     51   SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn      , kfillmode, pfillval, lsend, lrecv ) 
    5252#endif 
    53       ARRAY_TYPE(:,:,:,:,:)                                        ! array or pointer of arrays on which the boundary condition is applied 
     53      ARRAY_TYPE(1-nn_hls+1:,1-nn_hls+1:,:,:,:)                                        ! array or pointer of arrays on which the boundary condition is applied 
    5454      CHARACTER(len=*)              , INTENT(in   ) ::   cdname      ! name of the calling subroutine 
    5555      CHARACTER(len=1)              , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points 
     
    5858      REAL(wp),             OPTIONAL, INTENT(in   ) ::   pfillval    ! background value (used at closed boundaries) 
    5959      LOGICAL, DIMENSION(4),OPTIONAL, INTENT(in   ) ::   lsend, lrecv  ! communication with other 4 proc 
    60       INTEGER              ,OPTIONAL, INTENT(in   ) ::   ihlcom        ! number of ranks and rows to be communicated 
    6160      ! 
    6261      INTEGER  ::    ji,  jj,  jk,  jl,  jf      ! dummy loop indices 
     
    6665      INTEGER  ::   ierr 
    6766      INTEGER  ::   ifill_we, ifill_ea, ifill_so, ifill_no 
    68       INTEGER  ::   ihl                          ! number of ranks and rows to be communicated  
    6967      REAL(wp) ::   zland 
    7068      INTEGER , DIMENSION(MPI_STATUS_SIZE)        ::   istat          ! for mpi_isend 
     
    8381      ipl = L_SIZE(ptab)   ! 4th    - 
    8482      ipf = F_SIZE(ptab)   ! 5th    -      use in "multi" case (array of pointers) 
    85       ! 
    86       IF( PRESENT(ihlcom) ) THEN   ;   ihl = ihlcom 
    87       ELSE                         ;   ihl = 1 
    88       END IF 
    8983      ! 
    9084      IF( narea == 1 .AND. numcom == -1 ) CALL mpp_report( cdname, ipk, ipl, ipf, ld_lbc = .TRUE. ) 
     
    148142      ! -------------------------------------------------- ! 
    149143      ! 
     144 
    150145      ! Must exchange the whole column (from 1 to jpj) to get the corners if we have no south/north neighbourg 
    151       isize = ihl * jpj * ipk * ipl * ipf       
     146      isize = nn_hls * ( jpj + nn_hls - 1 ) * ipk * ipl * ipf       
    152147      ! 
    153148      ! Allocate local temporary arrays to be sent/received. Fill arrays to be sent 
    154       IF( llsend_we )   ALLOCATE( zsnd_we(ihl,jpj,ipk,ipl,ipf) ) 
    155       IF( llsend_ea )   ALLOCATE( zsnd_ea(ihl,jpj,ipk,ipl,ipf) ) 
    156       IF( llrecv_we )   ALLOCATE( zrcv_we(ihl,jpj,ipk,ipl,ipf) ) 
    157       IF( llrecv_ea )   ALLOCATE( zrcv_ea(ihl,jpj,ipk,ipl,ipf) ) 
     149      IF( llsend_we )   ALLOCATE( zsnd_we(nn_hls,1-nn_hls+1:jpj,ipk,ipl,ipf) ) 
     150      IF( llsend_ea )   ALLOCATE( zsnd_ea(nn_hls,1-nn_hls+1:jpj,ipk,ipl,ipf) ) 
     151      IF( llrecv_we )   ALLOCATE( zrcv_we(nn_hls,1-nn_hls+1:jpj,ipk,ipl,ipf) ) 
     152      IF( llrecv_ea )   ALLOCATE( zrcv_ea(nn_hls,1-nn_hls+1:jpj,ipk,ipl,ipf) ) 
    158153      ! 
    159154      IF( llsend_we ) THEN   ! copy western side of the inner mpi domain in local temporary array to be sent by MPI 
    160          ishift = ihl 
    161          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, ihl 
    162             zsnd_we(ji,jj,jk,jl,jf) = ARRAY_IN(ishift+ji,jj,jk,jl,jf)   ! ihl + 1 -> 2*ihl 
    163          END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    164       ENDIF 
    165       ! 
    166       IF(llsend_ea ) THEN   ! copy eastern side of the inner mpi domain in local temporary array to be sent by MPI 
    167          ishift = jpi - 2 * ihl 
    168          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, ihl 
    169             zsnd_ea(ji,jj,jk,jl,jf) = ARRAY_IN(ishift+ji,jj,jk,jl,jf)   ! jpi - 2*ihl + 1 -> jpi - ihl 
     155         ishift = 1 
     156         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1-nn_hls+1, jpj   ;   DO ji = 1, nn_hls 
     157            zsnd_we(ji,jj,jk,jl,jf) = ARRAY_IN(ishift+ji,jj,jk,jl,jf)   ! nn_hls + 1 -> 2*nn_hls 
     158         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
     159      ENDIF 
     160      ! 
     161      IF( llsend_ea ) THEN   ! copy eastern side of the inner mpi domain in local temporary array to be sent by MPI 
     162         ishift = jpi -  2 * nn_hls 
     163         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1-nn_hls+1, jpj   ;   DO ji = 1, nn_hls 
     164            zsnd_ea(ji,jj,jk,jl,jf) = ARRAY_IN(ishift+ji,jj,jk,jl,jf)   ! jpi - 2*nn_hls + 1 -> jpi - nn_hls 
    170165         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    171166      ENDIF 
     
    174169      ! 
    175170      ! non-blocking send of the western/eastern side using local temporary arrays 
    176       IF( llsend_we )   CALL mppsend( 1, zsnd_we(1,1,1,1,1), isize, nowe, ireq_we ) 
    177       IF( llsend_ea )   CALL mppsend( 2, zsnd_ea(1,1,1,1,1), isize, noea, ireq_ea ) 
     171      IF( llsend_we )   CALL mppsend( 1, zsnd_we(1,1-nn_hls+1,1,1,1), isize, nowe, ireq_we ) 
     172      IF( llsend_ea )   CALL mppsend( 2, zsnd_ea(1,1-nn_hls+1,1,1,1), isize, noea, ireq_ea ) 
    178173      ! blocking receive of the western/eastern halo in local temporary arrays 
    179       IF( llrecv_we )   CALL mpprecv( 2, zrcv_we(1,1,1,1,1), isize, nowe ) 
    180       IF( llrecv_ea )   CALL mpprecv( 1, zrcv_ea(1,1,1,1,1), isize, noea ) 
     174      IF( llrecv_we )   CALL mpprecv( 2, zrcv_we(1,1-nn_hls+1,1,1,1), isize, nowe ) 
     175      IF( llrecv_ea )   CALL mpprecv( 1, zrcv_ea(1,1-nn_hls+1,1,1,1), isize, noea ) 
    181176      ! 
    182177      IF( ln_timing ) CALL tic_tac(.FALSE.) 
     
    189184      ! 2.1 fill weastern halo 
    190185      ! ---------------------- 
    191       ! ishift = 0                         ! fill halo from ji = 1 to ihl 
     186      ! ishift = 0                         ! fill halo from ji = 1 to nn_hls 
    192187      SELECT CASE ( ifill_we ) 
    193188      CASE ( jpfillnothing )               ! no filling  
    194189      CASE ( jpfillmpi   )                 ! use data received by MPI  
    195          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, ihl 
    196             ARRAY_IN(ji,jj,jk,jl,jf) = zrcv_we(ji,jj,jk,jl,jf)   ! 1 -> ihl 
     190         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1-nn_hls+1, jpj   ;   DO ji = 1, nn_hls 
     191            ARRAY_IN(ji-nn_hls+1,jj,jk,jl,jf) = zrcv_we(ji,jj,jk,jl,jf)   ! 1 -> nn_hls 
    197192         END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
    198193      CASE ( jpfillperio )                 ! use east-weast periodicity 
    199          ishift2 = jpi - 2 * ihl 
    200          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, ihl 
    201             ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf) 
     194         ishift2 = jpi - 2 * nn_hls 
     195         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1-nn_hls+1, jpj   ;   DO ji = 1, nn_hls 
     196            ARRAY_IN(ji-nn_hls+1,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf) 
    202197         END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
    203198      CASE ( jpfillcopy  )                 ! filling with inner domain values 
    204199         DO jf = 1, ipf                               ! number of arrays to be treated 
    205200            IF( .NOT. NAT_IN(jf) == 'F' ) THEN        ! do nothing for F point 
    206                DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, ihl 
    207                   ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ihl+1,jj,jk,jl,jf) 
     201               DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1-nn_hls+1, jpj   ;   DO ji = 1, nn_hls 
     202                  ARRAY_IN(ji-nn_hls+1,jj,jk,jl,jf) = ARRAY_IN(1+ji,jj,jk,jl,jf) 
    208203               END DO   ;   END DO   ;   END DO   ;   END DO 
    209204            ENDIF 
     
    212207         DO jf = 1, ipf                               ! number of arrays to be treated 
    213208            IF( .NOT. NAT_IN(jf) == 'F' ) THEN        ! do nothing for F point 
    214                DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, ihl 
    215                   ARRAY_IN(ji,jj,jk,jl,jf) = zland 
     209               DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1-nn_hls+1, jpj   ;   DO ji = 1, nn_hls 
     210                  ARRAY_IN(ji-nn_hls+1,jj,jk,jl,jf) = zland 
    216211               END DO;   END DO   ;   END DO   ;   END DO 
    217212            ENDIF 
     
    221216      ! 2.2 fill eastern halo 
    222217      ! --------------------- 
    223       ishift = jpi - ihl                ! fill halo from ji = jpi-ihl+1 to jpi  
     218      ishift = jpi - nn_hls                ! fill halo from ji = jpi-nn_hls+1 to jpi  
    224219      SELECT CASE ( ifill_ea ) 
    225220      CASE ( jpfillnothing )               ! no filling  
    226221      CASE ( jpfillmpi   )                 ! use data received by MPI  
    227          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, ihl 
    228             ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zrcv_ea(ji,jj,jk,jl,jf)   ! jpi - ihl + 1 -> jpi 
     222         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1-nn_hls+1, jpj   ;   DO ji = 1, nn_hls 
     223            ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zrcv_ea(ji,jj,jk,jl,jf)   ! jpi - nn_hls + 1 -> jpi 
    229224         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    230225      CASE ( jpfillperio )                 ! use east-weast periodicity 
    231          ishift2 = ihl 
    232          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, ihl 
     226         ishift2 = 1 
     227         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1-nn_hls+1, jpj   ;   DO ji = 1, nn_hls 
    233228            ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf) 
    234229         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    235230      CASE ( jpfillcopy  )                 ! filling with inner domain values 
    236          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, ihl 
    237             ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ishift,jj,jk,jl,jf) 
     231       ishift2 = jpi - 2*nn_hls 
     232         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1-nn_hls+1, jpj   ;   DO ji = 1, nn_hls 
     233            ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf) 
    238234         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    239235      CASE ( jpfillcst   )                 ! filling with constant value 
    240          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, ihl 
     236         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1-nn_hls+1, jpj   ;   DO ji = 1, nn_hls 
    241237            ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zland 
    242238         END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
     
    264260      ! ---------------------------------------------------- ! 
    265261      ! 
    266       IF( llsend_so )   ALLOCATE( zsnd_so(jpi,ihl,ipk,ipl,ipf) ) 
    267       IF( llsend_no )   ALLOCATE( zsnd_no(jpi,ihl,ipk,ipl,ipf) ) 
    268       IF( llrecv_so )   ALLOCATE( zrcv_so(jpi,ihl,ipk,ipl,ipf) ) 
    269       IF( llrecv_no )   ALLOCATE( zrcv_no(jpi,ihl,ipk,ipl,ipf) ) 
    270       ! 
    271       isize = jpi * ihl * ipk * ipl * ipf       
     262      IF( llsend_so )   ALLOCATE( zsnd_so(1-nn_hls+1:jpi,nn_hls,ipk,ipl,ipf) ) 
     263      IF( llsend_no )   ALLOCATE( zsnd_no(1-nn_hls+1:jpi,nn_hls,ipk,ipl,ipf) ) 
     264      IF( llrecv_so )   ALLOCATE( zrcv_so(1-nn_hls+1:jpi,nn_hls,ipk,ipl,ipf) ) 
     265      IF( llrecv_no )   ALLOCATE( zrcv_no(1-nn_hls+1:jpi,nn_hls,ipk,ipl,ipf) ) 
     266      ! 
     267      isize = ( jpi + nn_hls - 1 ) * nn_hls * ipk * ipl * ipf       
    272268 
    273269      ! allocate local temporary arrays to be sent/received. Fill arrays to be sent 
    274270      IF( llsend_so ) THEN   ! copy sourhern side of the inner mpi domain in local temporary array to be sent by MPI 
    275          ishift = ihl 
    276          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, jpi 
    277             zsnd_so(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift+jj,jk,jl,jf)   ! ihl+1 -> 2*ihl 
     271         ishift = 1 
     272         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1-nn_hls+1, jpi 
     273            zsnd_so(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift+jj,jk,jl,jf)   ! nn_hls+1 -> 2*nn_hls 
    278274         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    279275      ENDIF 
    280276      ! 
    281277      IF( llsend_no ) THEN   ! copy eastern side of the inner mpi domain in local temporary array to be sent by MPI 
    282          ishift = jpj - 2 * ihl 
    283          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, jpi 
    284             zsnd_no(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift+jj,jk,jl,jf)   ! jpj-2*ihl+1 -> jpj-ihl 
     278         ishift = jpj - 2 * nn_hls 
     279         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1-nn_hls+1, jpi 
     280            zsnd_no(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift+jj,jk,jl,jf)   ! jpj-2*nn_hls+1 -> jpj-nn_hls 
    285281         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    286282      ENDIF 
     
    289285      ! 
    290286      ! non-blocking send of the southern/northern side 
    291       IF( llsend_so )   CALL mppsend( 3, zsnd_so(1,1,1,1,1), isize, noso, ireq_so ) 
    292       IF( llsend_no )   CALL mppsend( 4, zsnd_no(1,1,1,1,1), isize, nono, ireq_no ) 
     287      IF( llsend_so )   CALL mppsend( 3, zsnd_so(1-nn_hls+1,1,1,1,1), isize, noso, ireq_so ) 
     288      IF( llsend_no )   CALL mppsend( 4, zsnd_no(1-nn_hls+1,1,1,1,1), isize, nono, ireq_no ) 
    293289      ! blocking receive of the southern/northern halo 
    294       IF( llrecv_so )   CALL mpprecv( 4, zrcv_so(1,1,1,1,1), isize, noso ) 
    295       IF( llrecv_no )   CALL mpprecv( 3, zrcv_no(1,1,1,1,1), isize, nono ) 
     290      IF( llrecv_so )   CALL mpprecv( 4, zrcv_so(1-nn_hls+1,1,1,1,1), isize, noso ) 
     291      IF( llrecv_no )   CALL mpprecv( 3, zrcv_no(1-nn_hls+1,1,1,1,1), isize, nono ) 
    296292      ! 
    297293      IF( ln_timing ) CALL tic_tac(.FALSE.) 
     
    303299      ! 5.1 fill southern halo 
    304300      ! ---------------------- 
    305       ! ishift = 0                         ! fill halo from jj = 1 to ihl 
     301      ! ishift = 0                         ! fill halo from jj = 1 to nn_hls 
    306302      SELECT CASE ( ifill_so ) 
    307303      CASE ( jpfillnothing )               ! no filling  
    308304      CASE ( jpfillmpi   )                 ! use data received by MPI  
    309          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, jpi 
    310             ARRAY_IN(ji,jj,jk,jl,jf) = zrcv_so(ji,jj,jk,jl,jf)   ! 1 -> ihl 
     305         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1-nn_hls+1, jpi 
     306            ARRAY_IN(ji,jj-nn_hls+1,jk,jl,jf) = zrcv_so(ji,jj,jk,jl,jf)   ! 1 -> nn_hls 
    311307         END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
    312308      CASE ( jpfillperio )                 ! use north-south periodicity 
    313          ishift2 = jpj - 2 * ihl 
    314          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, jpi 
    315             ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf) 
     309         ishift2 = jpj - 2 * nn_hls 
     310         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1-nn_hls+1, jpi 
     311            ARRAY_IN(ji,jj-nn_hls+1,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf) 
    316312         END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
    317313      CASE ( jpfillcopy  )                 ! filling with inner domain values 
    318314         DO jf = 1, ipf                               ! number of arrays to be treated 
    319315            IF( .NOT. NAT_IN(jf) == 'F' ) THEN        ! do nothing for F point 
    320                DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, jpi 
    321                   ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ihl+1,jk,jl,jf) 
     316               DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1-nn_hls+1, jpi 
     317                  ARRAY_IN(ji,jj-nn_hls+1,jk,jl,jf) = ARRAY_IN(ji,1+jj,jk,jl,jf) 
    322318               END DO   ;   END DO   ;   END DO   ;   END DO 
    323319            ENDIF 
     
    326322         DO jf = 1, ipf                               ! number of arrays to be treated 
    327323            IF( .NOT. NAT_IN(jf) == 'F' ) THEN        ! do nothing for F point 
    328                DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, jpi  
    329                   ARRAY_IN(ji,jj,jk,jl,jf) = zland 
     324               DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1-nn_hls+1, jpi  
     325                  ARRAY_IN(ji,jj-nn_hls+1,jk,jl,jf) = zland 
    330326               END DO;   END DO   ;   END DO   ;   END DO 
    331327            ENDIF 
     
    335331      ! 5.2 fill northern halo 
    336332      ! ---------------------- 
    337       ishift = jpj - ihl                ! fill halo from jj = jpj-ihl+1 to jpj  
     333      ishift = jpj - nn_hls                ! fill halo from jj = jpj-nn_hls+1 to jpj  
    338334      SELECT CASE ( ifill_no ) 
    339335      CASE ( jpfillnothing )               ! no filling  
    340336      CASE ( jpfillmpi   )                 ! use data received by MPI  
    341          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, jpi 
    342             ARRAY_IN(ji,ishift+jj,jk,jl,jf) = zrcv_no(ji,jj,jk,jl,jf)   ! jpj-ihl+1 -> jpj 
     337         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1-nn_hls+1, jpi 
     338            ARRAY_IN(ji,ishift+jj,jk,jl,jf) = zrcv_no(ji,jj,jk,jl,jf)   ! jpj-nn_hls+1 -> jpj 
    343339         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    344340      CASE ( jpfillperio )                 ! use north-south periodicity 
    345          ishift2 = ihl 
    346          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, jpi 
     341         ishift2 = 1 
     342         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1-nn_hls+1, jpi 
    347343            ARRAY_IN(ji,ishift+jj,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf) 
    348344         END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
    349345      CASE ( jpfillcopy  )                 ! filling with inner domain values 
    350          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, jpi 
    351             ARRAY_IN(ji,ishift+jj,jk,jl,jf) = ARRAY_IN(ji,ishift,jk,jl,jf) 
     346          ishift2 = jpj - 2*nn_hls 
     347         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1-nn_hls+1, jpi 
     348            ARRAY_IN(ji,ishift+jj,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf) 
    352349         END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
    353350      CASE ( jpfillcst   )                 ! filling with constant value 
    354          DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, ihl   ;   DO ji = 1, jpi 
     351         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1-nn_hls+1, jpi 
    355352            ARRAY_IN(ji,ishift+jj,jk,jl,jf) = zland 
    356353         END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
Note: See TracChangeset for help on using the changeset viewer.