Changeset 12719


Ignore:
Timestamp:
2020-04-08T17:45:31+02:00 (6 months ago)
Author:
francesca
Message:

extra-halo management with positive arrays indices - ticket #2366

Location:
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE
Files:
7 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/halo_mng.F90

    r12586 r12719  
    2727   INTEGER :: jpimax_1, jpjmax_1 
    2828   INTEGER :: nlci_1, nlcj_1 
    29    INTEGER :: jplbi_1, jplbj_1 
     29   INTEGER :: nldi_1, nldj_1 
     30   INTEGER :: nlei_1, nlej_1 
    3031CONTAINS 
    3132 
     
    3839        nlcj_1 = nlcj 
    3940 
    40         jplbi_1 = 1  
    41         jplbj_1 = 1  
    42          
    43         jplbi = 1  
    44         jplbj = 1  
     41        nldi_1 = nldi 
     42        nldj_1 = nldj 
    4543 
    46          jpimax_1 = jpimax 
    47          jpjmax_1 = jpjmax 
     44        nlei_1 = nlei 
     45        nlej_1 = nlej 
     46 
     47      jpimax_1 = jpimax 
     48      jpjmax_1 = jpjmax 
    4849 
    4950   END SUBROUTINE halo_mng_init 
     
    5455 
    5556        nn_hls = khls 
    56         jpi = jpi_1 + khls -1 
    57         jpj = jpj_1 + khls -1 
    5857 
    59         nlci = nlci_1 + khls -1 
    60         nlcj = nlcj_1 + khls -1 
     58        jpi = jpi_1 + 2*khls -2 
     59        jpj = jpj_1 + 2*khls -2 
     60 
     61        nlci = nlci_1 + 2*khls -2 
     62        nlcj = nlcj_1 + 2*khls -2 
    6163         
    62         jplbi = jplbi_1 - khls +1  
    63         jplbj = jplbj_1 - khls +1  
    64          
    65         jpimax = jpimax_1 + khls -1 
    66         jpjmax = jpjmax_1 + khls -1 
     64        jpimax = jpimax_1 + 2*khls -2 
     65        jpjmax = jpjmax_1 + 2*khls -2 
     66 
     67        nldi = nldi_1 + khls - 1 
     68        nldj = nldj_1 + khls - 1 
     69 
     70        nlei = nlei_1 + khls - 1 
     71        nlej = nlej_1 + khls - 1 
    6772 
    6873   END SUBROUTINE halo_mng_set 
     
    7681      REAL(wp), POINTER, DIMENSION(:,:) :: zpta 
    7782      INTEGER :: offset 
    78       INTEGER :: pta_size_i, pta_size_j, exp_size_i, exp_size_j 
     83      INTEGER :: pta_size_i, pta_size_j 
    7984 
    8085      pta_size_i = SIZE(pta,1) 
    8186      pta_size_j = SIZE(pta,2) 
    82       exp_size_i = jpi - jplbi + 1 
    83       exp_size_j = jpj - jplbj + 1 
    8487       
    8588      ! check if the current size of pta is equal to the current expected dimension 
    86       IF (pta_size_i .ne. exp_size_i) THEN 
    87          ALLOCATE (zpta(jplbi:jpi, jplbj:jpj)) 
    88          offset = (exp_size_i - pta_size_i) / 2  
     89      IF (pta_size_i .ne. jpi) THEN 
     90         ALLOCATE (zpta(jpi, jpj)) 
     91         offset = abs((jpi - pta_size_i) / 2)  
    8992 
    90          IF (pta_size_i .lt. exp_size_i) THEN 
    91             zpta (offset+jplbi : offset+pta_size_i+jplbi-1, offset+jplbj : offset+pta_size_j+jplbj-1) = pta 
     93         IF (pta_size_i .lt. jpi) THEN 
     94            zpta (offset+1 : offset+pta_size_i, offset+1 : offset+pta_size_j) = pta 
    9295         ELSE 
    93             zpta = pta(jplbi : jpi, jplbj : jpj) 
     96            zpta = pta(offset+1 : offset+jpi, offset+1 : offset+jpj) 
    9497         END IF 
    9598         CALL lbc_lnk( 'halo_mng_resize_2D', zpta, cdna, psgn, pfillval=fillval) 
     
    108111      REAL(wp), POINTER, DIMENSION(:,:,:) :: zpta 
    109112      INTEGER :: offset 
    110       INTEGER :: pta_size_i, pta_size_j, exp_size_i, exp_size_j 
     113      INTEGER :: pta_size_i, pta_size_j 
    111114 
    112115      pta_size_i = SIZE(pta,1) 
    113116      pta_size_j = SIZE(pta,2) 
    114       exp_size_i = jpi - jplbi + 1 
    115       exp_size_j = jpj - jplbj + 1 
    116117       
    117118      ! check if the current size of pta is equal to the current expected dimension 
    118       IF (pta_size_i .ne. exp_size_i) THEN 
    119          ALLOCATE (zpta(jplbi:jpi, jplbj:jpj, jpk)) 
    120          offset = (exp_size_i - pta_size_i) / 2  
     119      IF (pta_size_i .ne. jpi) THEN 
     120         ALLOCATE (zpta(jpi, jpj, jpk)) 
     121         offset = abs((jpi - pta_size_i) / 2)  
    121122 
    122          IF (pta_size_i .lt. exp_size_i) THEN 
    123             zpta (offset+jplbi : offset+pta_size_i+jplbi-1, offset+jplbj : offset+pta_size_j+jplbj-1, :) = pta 
     123         IF (pta_size_i .lt. jpi) THEN 
     124            zpta (offset+1 : offset+pta_size_i, offset+1 : offset+pta_size_j, :) = pta 
    124125         ELSE 
    125             zpta = pta(jplbi : jpi, jplbj : jpj, :) 
     126            zpta = pta(offset+1 : offset+jpi, offset+1 : offset+jpj, :) 
    126127         END IF 
    127128         CALL lbc_lnk( 'halo_mng_resize_3D', zpta, cdna, psgn, pfillval=fillval) 
     
    141142      REAL(wp), POINTER, DIMENSION(:,:,:,:) :: zpta 
    142143      INTEGER :: offset 
    143       INTEGER :: pta_size_i, pta_size_j, exp_size_i, exp_size_j 
     144      INTEGER :: pta_size_i, pta_size_j 
    144145 
    145146      pta_size_i = SIZE(pta,1) 
    146147      pta_size_j = SIZE(pta,2) 
    147       exp_size_i = jpi - jplbi + 1 
    148       exp_size_j = jpj - jplbj + 1 
    149148       
    150149      ! check if the current size of pta is equal to the current expected dimension 
    151       IF (pta_size_i .ne. exp_size_i) THEN 
    152          ALLOCATE (zpta(jplbi:jpi, jplbj:jpj, jpk, jpt)) 
    153          offset = (exp_size_i - pta_size_i) / 2  
     150      IF (pta_size_i .ne. jpi) THEN 
     151         ALLOCATE (zpta(jpi, jpj, jpk, jpt)) 
     152         offset = abs((jpi - pta_size_i) / 2)  
    154153 
    155          IF (pta_size_i .lt. exp_size_i) THEN 
    156             zpta (offset+jplbi : offset+pta_size_i+jplbi-1, offset+jplbj : offset+pta_size_j+jplbj-1, :, :) = pta 
     154         IF (pta_size_i .lt. jpi) THEN 
     155            zpta (offset+1 : offset+pta_size_i, offset+1 : offset+pta_size_j, :, :) = pta 
    157156         ELSE 
    158             zpta = pta(jplbi : jpi, jplbj : jpj, :, :) 
     157            zpta = pta(offset+1 : offset+jpi, offset+1 : offset+jpj, :, :) 
    159158         END IF 
    160159         CALL lbc_lnk( 'halo_mng_resize_4D', zpta(:,:,:,fjpt), cdna, psgn, pfillval=fillval) 
     
    175174      REAL(wp), POINTER, DIMENSION(:,:,:,:,:) :: zpta 
    176175      INTEGER :: offset 
    177       INTEGER :: pta_size_i, pta_size_j, exp_size_i, exp_size_j 
     176      INTEGER :: pta_size_i, pta_size_j 
    178177 
    179178      pta_size_i = SIZE(pta,1) 
    180179      pta_size_j = SIZE(pta,2) 
    181       exp_size_i = jpi - jplbi + 1 
    182       exp_size_j = jpj - jplbj + 1 
    183180       
    184181      ! check if the current size of pta is equal to the current expected dimension 
    185       IF (pta_size_i .ne. exp_size_i) THEN 
    186          ALLOCATE (zpta(jplbi:jpi, jplbj:jpj, jpk, kjpt, jpt)) 
    187          offset = (exp_size_i - pta_size_i) / 2  
     182      IF (pta_size_i .ne. jpi) THEN 
     183         ALLOCATE (zpta(jpi, jpj, jpk, kjpt, jpt)) 
     184         offset = abs((jpi - pta_size_i) / 2)  
    188185 
    189          IF (pta_size_i .lt. exp_size_i) THEN 
    190             zpta (offset+jplbi : offset+pta_size_i+jplbi-1, offset+jplbj : offset+pta_size_j+jplbj-1, :, :, :) = pta 
     186         IF (pta_size_i .lt. jpi) THEN 
     187            zpta (offset+1 : offset+pta_size_i, offset+1 : offset+pta_size_j, :, :, :) = pta 
    191188         ELSE 
    192             zpta = pta(jplbi : jpi, jplbj : jpj, :, :, :) 
     189            zpta = pta(offset+1 : offset+jpi, offset+1 : offset+jpj, :, :, :) 
    193190         END IF 
    194191         CALL lbc_lnk( 'halo_mng_resize_5D', zpta(:,:,:,:,fjpt), cdna, psgn, pfillval=fillval) 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/lbc_nfd_nogather_generic.h90

    r12601 r12719  
    5757      !! 
    5858      !!---------------------------------------------------------------------- 
    59       ARRAY_TYPE(1-nn_hls+1:,1-nn_hls+1:,:,:,:) 
    60       ARRAY2_TYPE(1-nn_hls+1:,:,:,:,:)  
     59      ARRAY_TYPE(:,:,:,:,:) 
     60      ARRAY2_TYPE(:,:,:,:,:)  
    6161      CHARACTER(len=1) , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points 
    6262      REAL(wp)         , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary 
     
    9191            ! 
    9292            CASE ( 'T' , 'W' )                         ! T-, W-point 
    93                IF ( nimpp - nn_hls+1 /= 1 ) THEN  ;  startloop = 1 - nn_hls + 1 
    94                ELSE                     ;   startloop = 2 
     93               IF ( nimpp /= 1 ) THEN  ;  startloop = 1  
     94               ELSE                    ;  startloop = 1 + nn_hls 
    9595               ENDIF 
    9696               ! 
    9797               DO jl = 1, ipl; DO jk = 1, ipk 
    9898                    DO jj = 1, nn_hls 
     99                       ijj = nlcj -jj +1 
     100                     DO ji = startloop, nlci 
     101                     ijt = jpiglo - (ji + nimpp-nn_hls+1 ) - nfiimpp(isendto(1),jpnj) + 4 
     102                        ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf) 
     103                     END DO 
     104                  END DO 
     105               END DO; END DO 
     106               IF( nimpp == 1 ) THEN 
     107                  DO jl = 1, ipl; DO jk = 1, ipk 
     108                     DO jj = 1, nn_hls 
    99109                     ijj = nlcj -jj +1 
    100                      DO ji = startloop, nlci 
    101                      ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    102                         ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf) 
    103                     END DO 
    104                   END DO 
    105                END DO; END DO 
    106                IF( nimpp - nn_hls+1 == 1 ) THEN 
    107                   DO jl = 1, ipl; DO jk = 1, ipk 
    108                      DO jj = 1, nn_hls 
    109                         ijj = nlcj -jj +1 
    110                         DO ii = 1, nn_hls 
    111                               ARRAY_IN(1-ii+1,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ii+2,nlcj-2*nn_hls+jj-1,jk,jl,jf) 
    112                         END DO 
    113                      END DO 
     110                     DO ii = 0, nn_hls-1 
     111                        ARRAY_IN(ii+1,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii+1,nlcj-2*nn_hls+jj-1,jk,jl,jf) 
     112                     END DO 
     113                     END DO 
    114114                  END DO; END DO 
    115115               ENDIF               
    116116               ! 
    117117               IF ( .NOT. l_fast_exchanges ) THEN 
    118                   IF( nimpp - nn_hls +1 >= jpiglo/2+1 ) THEN 
    119                      startloop = 1 - nn_hls +1 
    120                 ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp - nn_hls +1 < jpiglo/2+1 ) THEN 
     118                  IF( nimpp >= jpiglo/2+1 ) THEN 
     119                     startloop = 1 
     120                  ELSEIF( nimpp+nlci-2*nn_hls+1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN 
    121121                     startloop = jpiglo/2+1 - nimpp + nn_hls 
    122122                  ELSE 
     
    126126                     DO jl = 1, ipl; DO jk = 1, ipk 
    127127                        DO ji = startloop, nlci 
    128                            ijt  = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    129                            jia  = ji + nimpp - 1 
     128                           ijt  = jpiglo - (ji + nimpp -nn_hls+1)- nfiimpp(isendto(1),jpnj) + 4 
     129                           jia  = ji + nimpp -nn_hls 
    130130                           ijta = jpiglo - jia + 2 
    131131                           IF( ijta >= startloop+nimpp-1 .AND. ijta < jia ) THEN 
    132                               ARRAY_IN(ji,nlcj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijta-nimpp+1,nlcj-nn_hls,jk,jl,jf) 
     132                              ARRAY_IN(ji,nlcj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijta-nimpp+nn_hls,nlcj-nn_hls,jk,jl,jf) 
    133133                           ELSE 
    134134                              ARRAY_IN(ji,nlcj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,nn_hls+1,jk,jl,jf) 
     
    139139               ENDIF 
    140140            CASE ( 'U' )                                     ! U-point 
    141                IF( nimpp + nlci - nn_hls /= jpiglo ) THEN 
     141               IF( nimpp + nlci - 2*nn_hls+1 /= jpiglo ) THEN 
    142142                  endloop = nlci 
    143143               ELSE 
     
    145145               ENDIF 
    146146               DO jl = 1, ipl; DO jk = 1, ipk 
    147               DO jj = 1, nn_hls 
    148                      ijj = nlcj -jj +1 
    149                      DO ji = 1-nn_hls+1, endloop 
    150                      iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    151                         ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,jj,jk,jl,jf) 
    152                      END DO 
    153                   END DO 
    154                END DO; END DO 
    155                IF (nimpp - nn_hls+1 .eq. 1) THEN 
    156                DO jj = 1, nn_hls 
    157                   ijj = nlcj -jj +1 
    158                   DO ii = 1, nn_hls 
    159                      ARRAY_IN(2-ii,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ii+1,nlcj-2*nn_hls+jj-1,:,:,jf) 
    160                   END DO 
    161                      END DO 
    162                ENDIF 
    163                IF((nimpp + nlci - nn_hls) .eq. jpiglo) THEN 
    164                      DO jj = 1, nn_hls 
    165                         ijj = nlcj -jj +1 
    166                   DO ii = 1, nn_hls 
    167                      ARRAY_IN(nlci-ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-2*nn_hls+ii,nlcj-2*nn_hls+jj-1,:,:,jf) 
    168                   END DO 
    169                END DO 
    170                ENDIF 
    171                ! 
    172                IF ( .NOT. l_fast_exchanges ) THEN 
    173                   IF( nimpp + nlci - nn_hls /= jpiglo ) THEN 
     147        DO jj = 1, nn_hls 
     148              ijj = nlcj -jj +1 
     149                     DO ji = 1, endloop 
     150                        iju = jpiglo - (ji + nimpp -nn_hls+1)- nfiimpp(isendto(1),jpnj) + 3 
     151                        ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,jj,jk,jl,jf) 
     152                     END DO 
     153                  END DO 
     154               END DO; END DO 
     155               IF (nimpp .eq. 1) THEN 
     156        DO jj = 1, nn_hls 
     157           ijj = nlcj -jj +1 
     158           DO ii = 0, nn_hls-1 
     159         ARRAY_IN(ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii,nlcj-2*nn_hls+jj-1,:,:,jf) 
     160           END DO 
     161                  END DO 
     162               ENDIF 
     163               IF((nimpp + nlci - 2*nn_hls+1) .eq. jpiglo) THEN 
     164                  DO jj = 1, nn_hls 
     165                       ijj = nlcj -jj +1 
     166         DO ii = 1, nn_hls 
     167               ARRAY_IN(nlci-ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-2*nn_hls+ii,nlcj-2*nn_hls+jj-1,:,:,jf) 
     168         END DO 
     169        END DO 
     170               ENDIF 
     171               ! 
     172               IF ( .NOT. l_fast_exchanges ) THEN 
     173                  IF( nimpp + nlci - 2*nn_hls+1 /= jpiglo ) THEN 
    174174                     endloop = nlci 
    175175                  ELSE 
    176176                     endloop = nlci - nn_hls 
    177177                  ENDIF 
    178                   IF( nimpp - nn_hls+1 >= jpiglo/2 ) THEN 
    179                      startloop = 1- nn_hls + 1 
    180                      ELSEIF( ( nimpp+nlci-1 >= jpiglo/2 ) .AND. ( nimpp - nn_hls+1 < jpiglo/2 ) ) THEN 
    181                      startloop = jpiglo/2 - nimpp + nn_hls 
     178                  IF( nimpp >= jpiglo/2 ) THEN 
     179                     startloop = 1 
     180                  ELSEIF( ( nimpp + nlci - 2*nn_hls+1 >= jpiglo/2 ) .AND. ( nimpp < jpiglo/2 ) ) THEN 
     181                     startloop = jpiglo/2 - (nimpp -nn_hls+1) +1 
    182182                  ELSE 
    183183                     startloop = endloop + 1 
     
    186186                  DO jl = 1, ipl; DO jk = 1, ipk 
    187187                     DO ji = startloop, endloop 
    188                         iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    189                         jia = ji + nimpp - 1 
     188                        iju = jpiglo - (ji + nimpp -nn_hls+1) - nfiimpp(isendto(1),jpnj) + 3 
     189                        jia = ji + nimpp -nn_hls 
    190190                        ijua = jpiglo - jia + 1 
    191191                        IF( ijua >= startloop+nimpp-1 .AND. ijua < jia ) THEN 
    192                            ARRAY_IN(ji,nlcj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijua-nimpp+1,nlcj-nn_hls,jk,jl,jf) 
     192                           ARRAY_IN(ji,nlcj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY_IN(ijua-nimpp+nn_hls,nlcj-nn_hls,jk,jl,jf) 
    193193                        ELSE 
    194194                           ARRAY_IN(ji,nlcj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,nn_hls+1,jk,jl,jf) 
     
    200200               ! 
    201201            CASE ( 'V' )                                     ! V-point 
    202                IF( nimpp - nn_hls+1 /= 1 ) THEN 
    203                  startloop = 1 - nn_hls + 1 
     202               IF( nimpp /= 1 ) THEN 
     203                 startloop = 1  
    204204               ELSE 
    205                  startloop = 2 
    206                ENDIF 
    207                IF ( .NOT. l_fast_exchanges ) THEN 
    208                   DO jl = 1, ipl; DO jk = 1, ipk 
    209                      DO jj = 2, nn_hls+1 
    210                         ijj = nlcj -jj +1 
     205                 startloop = 1 + nn_hls 
     206               ENDIF 
     207               IF ( .NOT. l_fast_exchanges ) THEN 
     208                  DO jl = 1, ipl; DO jk = 1, ipk 
     209                       DO jj = 2, nn_hls+1 
     210                     ijj = nlcj -jj +1 
    211211                        DO ji = startloop, nlci 
    212                            ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
    213                            ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf) 
     212                           ijt=jpiglo - (ji +nimpp -nn_hls+1)- nfiimpp(isendto(1),jpnj) + 4 
     213                           ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf) 
    214214                        END DO 
    215215                    END DO 
     
    218218               DO jl = 1, ipl; DO jk = 1, ipk 
    219219                  DO ji = startloop, nlci 
    220                      ijt=jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 4 
     220                     ijt=jpiglo - (ji + nimpp -nn_hls+1)- nfiimpp(isendto(1),jpnj) + 4 
    221221                     ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,1,jk,jl,jf) 
    222222                  END DO 
    223223               END DO; END DO 
    224                IF (nimpp - nn_hls+1.eq. 1) THEN 
    225                DO jj = 1, nn_hls 
    226                         ijj = nlcj-jj+1 
    227                         DO ii = 1, nn_hls 
    228                         ARRAY_IN(1-ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ii+2,nlcj-2*nn_hls+jj-1,:,:,jf) 
    229                   END DO 
    230                END DO 
     224               IF (nimpp .eq. 1) THEN 
     225        DO jj = 1, nn_hls 
     226                       ijj = nlcj-jj+1 
     227                       DO ii = 0, nn_hls-1 
     228                        ARRAY_IN(ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii+1,nlcj-2*nn_hls+jj-1,:,:,jf) 
     229           END DO 
     230        END DO 
    231231               ENDIF 
    232232            CASE ( 'F' )                                     ! F-point 
    233                IF( nimpp + nlci - nn_hls /= jpiglo ) THEN 
     233               IF( nimpp + nlci - 2*nn_hls+1 /= jpiglo ) THEN 
    234234                  endloop = nlci 
    235235               ELSE 
     
    238238               IF ( .NOT. l_fast_exchanges ) THEN 
    239239                  DO jl = 1, ipl; DO jk = 1, ipk 
    240                      DO jj = 2, nn_hls+1 
    241                         ijj = nlcj -jj +1 
    242                         DO ji = 1 - nn_hls +1, endloop 
    243                            iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
    244                            ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,jj,jk,jl,jf) 
     240                       DO jj = 2, nn_hls+1 
     241                     ijj = nlcj -jj +1 
     242                        DO ji = 1, endloop 
     243                           iju = jpiglo - (ji + nimpp -nn_hls+1) - nfiimpp(isendto(1),jpnj) + 3 
     244                           ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,jj,jk,jl,jf) 
    245245                        END DO 
    246246                    END DO 
     
    248248               ENDIF 
    249249               DO jl = 1, ipl; DO jk = 1, ipk 
    250                   DO ji = 1- nn_hls +1, endloop 
    251                      iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
     250                  DO ji = 1, endloop 
     251                     iju = jpiglo - (ji + nimpp -nn_hls+1) - nfiimpp(isendto(1),jpnj) + 3 
    252252                     ARRAY_IN(ji,nlcj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,1,jk,jl,jf) 
    253253                  END DO 
    254254               END DO; END DO 
    255       IF (nimpp - nn_hls+1.eq. 1) THEN                
    256          DO ii = 1, nn_hls 
    257                      ARRAY_IN(2-ii,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ii+1,nlcj-2*nn_hls-1,:,:,jf) 
    258          END DO 
    259          IF ( .NOT. l_fast_exchanges ) THEN 
    260             DO jj = 1, nn_hls 
    261                            ijj = nlcj -jj 
    262                            DO ii = 1, nn_hls 
    263                            ARRAY_IN(2-ii,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(ii+1,nlcj-2*nn_hls+jj-1,:,:,jf) 
    264                               END DO 
    265                         END DO 
    266                      ENDIF 
     255      IF (nimpp .eq. 1) THEN                
     256         DO ii = 1, nn_hls 
     257                 ARRAY_IN(ii+1,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii,nlcj-2*nn_hls-1,:,:,jf) 
     258         END DO 
     259         IF ( .NOT. l_fast_exchanges ) THEN 
     260            DO jj = 1, nn_hls 
     261                      ijj = nlcj -jj 
     262                      DO ii = 1, nn_hls 
     263                         ARRAY_IN(2-ii,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(2*nn_hls-ii,nlcj-2*nn_hls+jj-1,:,:,jf) 
     264                   END DO 
     265                      END DO 
     266                     ENDIF 
    267267      ENDIF 
    268       IF((nimpp + nlci - nn_hls ) .eq. jpiglo) THEN 
    269                      DO ii = 1, nn_hls 
    270                      ARRAY_IN(nlci-ii+1,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-2*nn_hls+ii,nlcj-2*nn_hls-1,:,:,jf) 
    271          END DO 
    272          IF ( .NOT. l_fast_exchanges ) THEN 
    273             DO jj = 1, nn_hls 
    274                            ijj = nlcj -jj 
    275                            DO ii = 1, nn_hls 
    276                            ARRAY_IN(nlci-ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-2*nn_hls+ii,nlcj-2*nn_hls+jj-1,:,:,jf) 
    277                            END DO 
    278                         END DO 
    279                      ENDIF 
     268      IF((nimpp + nlci - 2*nn_hls+1 ) .eq. jpiglo) THEN 
     269                   DO ii = 1, nn_hls 
     270                 ARRAY_IN(nlci-ii+1,nlcj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-2*nn_hls+ii,nlcj-2*nn_hls-1,:,:,jf) 
     271         END DO 
     272         IF ( .NOT. l_fast_exchanges ) THEN 
     273            DO jj = 1, nn_hls 
     274                           ijj = nlcj -jj 
     275                      DO ii = 1, nn_hls 
     276                         ARRAY_IN(nlci-ii+1,ijj,:,:,jf) = SGN_IN(jf) * ARRAY_IN(nlci-2*nn_hls+ii,nlcj-2*nn_hls+jj-1,:,:,jf) 
     277                         END DO 
     278                      END DO 
     279                     ENDIF 
    280280                  ENDIF 
    281281                  ! 
     
    290290           ijj = nlcj-jj+1 
    291291           DO ji = 1, nlci 
    292                         ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
     292                        ijt = jpiglo - ( ji + nimpp -nn_hls+1) - nfiimpp(isendto(1),jpnj) + 3 
    293293                        ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf) 
    294294                     END DO 
     
    297297               ! 
    298298            CASE ( 'U' )                                     ! U-point 
    299                IF( nimpp + nlci - nn_hls /= jpiglo ) THEN 
     299               IF( nimpp + nlci - 2*nn_hls+1 /= jpiglo ) THEN 
    300300                  endloop = nlci 
    301301               ELSE 
     
    306306           ijj = nlcj-jj+1 
    307307                     DO ji = 1, endloop 
    308                         iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
     308                        iju = jpiglo- (ji + nimpp -nn_hls+1) - nfiimpp(isendto(1),jpnj) + 2 
    309309                        ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,jj,jk,jl,jf) 
    310310                     END DO 
    311311                  END DO 
    312312               END DO; END DO 
    313                IF((nimpp + nlci - nn_hls) .eq. jpiglo) THEN 
     313               IF(nimpp + nlci - 2*nn_hls+1 .eq. jpiglo) THEN 
    314314                  DO jl = 1, ipl; DO jk = 1, ipk 
    315315                     DO jj = 1, nn_hls 
     
    325325            CASE ( 'V' )                                     ! V-point 
    326326               DO jl = 1, ipl; DO jk = 1, ipk 
    327                   DO ji = 1, nlci 
    328            DO jj = 1, nn_hls 
    329          ijj = nlcj -jj +1 
    330                         ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
     327        DO jj = 1, nn_hls 
     328           ijj = nlcj -jj +1 
     329                     DO ji = 1, nlci 
     330                        ijt = jpiglo - (ji + nimpp -nn_hls+1) - nfiimpp(isendto(1),jpnj) + 3 
    331331                        ARRAY_IN(ji,ijj,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,jj,jk,jl,jf) 
    332332                     END DO 
     
    335335 
    336336               IF ( .NOT. l_fast_exchanges ) THEN 
    337                   IF( nimpp -nn_hls+1 >= jpiglo/2+1 ) THEN 
    338                      startloop = 1-nn_hls+1 
    339                   ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp - nn_hls+1 < jpiglo/2+1 ) THEN 
     337                  IF( nimpp >= jpiglo/2+1 ) THEN 
     338                     startloop = 1 
     339                  ELSEIF( nimpp+nlci-2*nn_hls+1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN 
    340340                     startloop = jpiglo/2+1 - nimpp + nn_hls 
    341341                  ELSE 
     
    345345                  DO jl = 1, ipl; DO jk = 1, ipk 
    346346                        DO ji = startloop, nlci 
    347                         ijt = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 3 
     347                        ijt = jpiglo - (ji + nimpp -nn_hls+1) - nfiimpp(isendto(1),jpnj) + 3 
    348348                           ARRAY_IN(ji,nlcj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(ijt,nn_hls+1,jk,jl,jf) 
    349349                        END DO 
     
    353353               ! 
    354354            CASE ( 'F' )                               ! F-point 
    355                IF( nimpp + nlci - nn_hls /= jpiglo ) THEN 
     355               IF( nimpp + nlci - 2*nn_hls+1 /= jpiglo ) THEN 
    356356                  endloop = nlci 
    357357               ELSE 
     
    362362          ijj = nlcj -jj +1 
    363363                    DO ji = 1, endloop 
    364                        iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
     364                       iju = jpiglo - (ji + nimpp -nn_hls+1) - nfiimpp(isendto(1),jpnj) + 2 
    365365                       ARRAY_IN(ji,ijj ,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,jj,jk,jl,jf) 
    366366                     END DO 
    367367                  END DO 
    368368               END DO; END DO 
    369                IF((nimpp + nlci - nn_hls) .eq. jpiglo) THEN 
     369               IF((nimpp + nlci - 2*nn_hls+1) .eq. jpiglo) THEN 
    370370                  DO jl = 1, ipl; DO jk = 1, ipk 
    371371                     DO jj = 1, nn_hls 
     
    380380               ! 
    381381               IF ( .NOT. l_fast_exchanges ) THEN 
    382                   IF( nimpp + nlci - nn_hls /= jpiglo ) THEN 
     382                  IF( nimpp + nlci - 2*nn_hls+1 /= jpiglo ) THEN 
    383383                     endloop = nlci 
    384384                  ELSE 
    385385                     endloop = nlci - nn_hls 
    386386                  ENDIF 
    387                   IF( nimpp - nn_hls+1 >= jpiglo/2+1 ) THEN 
    388                      startloop = 1 - nn_hls+1 
    389                   ELSEIF( nimpp+nlci-1 >= jpiglo/2+1 .AND. nimpp - nn_hls+1 < jpiglo/2+1 ) THEN 
     387                  IF( nimpp >= jpiglo/2+1 ) THEN 
     388                     startloop = 1  
     389                  ELSEIF( nimpp+nlci-2*nn_hls+1 >= jpiglo/2+1 .AND. nimpp < jpiglo/2+1 ) THEN 
    390390                     startloop = jpiglo/2+1 - nimpp + nn_hls 
    391391                  ELSE 
     
    395395                     DO jl = 1, ipl; DO jk = 1, ipk 
    396396                        DO ji = startloop, endloop 
    397                            iju = jpiglo - ji - nimpp - nfiimpp(isendto(1),jpnj) + 2 
     397                           iju = jpiglo - (ji + nimpp -nn_hls+1) - nfiimpp(isendto(1),jpnj) + 2 
    398398                           ARRAY_IN(ji,nlcj-nn_hls,jk,jl,jf) = SGN_IN(jf) * ARRAY2_IN(iju,nn_hls+1,jk,jl,jf) 
    399399                        END DO 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/mpp_lnk_generic.h90

    r12586 r12719  
    5151   SUBROUTINE ROUTINE_LNK( cdname, ptab, cd_nat, psgn      , kfillmode, pfillval, lsend, lrecv ) 
    5252#endif 
    53       ARRAY_TYPE(1-nn_hls+1:,1-nn_hls+1:,:,:,:)                                        ! array or pointer of arrays on which the boundary condition is applied 
     53      ARRAY_TYPE(:,:,:,:,:)                                        ! 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 
     
    142142      ! -------------------------------------------------- ! 
    143143      ! 
    144  
    145144      ! Must exchange the whole column (from 1 to jpj) to get the corners if we have no south/north neighbourg 
    146       isize = nn_hls * ( jpj + nn_hls - 1 ) * ipk * ipl * ipf       
     145      isize = nn_hls * jpj * ipk * ipl * ipf       
    147146      ! 
    148147      ! Allocate local temporary arrays to be sent/received. Fill arrays to be sent 
    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) ) 
     148      IF( llsend_we )   ALLOCATE( zsnd_we(nn_hls,jpj,ipk,ipl,ipf) ) 
     149      IF( llsend_ea )   ALLOCATE( zsnd_ea(nn_hls,jpj,ipk,ipl,ipf) ) 
     150      IF( llrecv_we )   ALLOCATE( zrcv_we(nn_hls,jpj,ipk,ipl,ipf) ) 
     151      IF( llrecv_ea )   ALLOCATE( zrcv_ea(nn_hls,jpj,ipk,ipl,ipf) ) 
    153152      ! 
    154153      IF( llsend_we ) THEN   ! copy western side of the inner mpi domain in local temporary array to be sent by MPI 
    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 
     154         ishift = nn_hls 
     155         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls 
    157156            zsnd_we(ji,jj,jk,jl,jf) = ARRAY_IN(ishift+ji,jj,jk,jl,jf)   ! nn_hls + 1 -> 2*nn_hls 
    158157         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    159158      ENDIF 
    160159      ! 
    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 
     160      IF(llsend_ea ) THEN   ! copy eastern side of the inner mpi domain in local temporary array to be sent by MPI 
     161         ishift = jpi - 2 * nn_hls 
     162         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls 
    164163            zsnd_ea(ji,jj,jk,jl,jf) = ARRAY_IN(ishift+ji,jj,jk,jl,jf)   ! jpi - 2*nn_hls + 1 -> jpi - nn_hls 
    165164         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
     
    169168      ! 
    170169      ! non-blocking send of the western/eastern side using local temporary arrays 
    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 ) 
     170      IF( llsend_we )   CALL mppsend( 1, zsnd_we(1,1,1,1,1), isize, nowe, ireq_we ) 
     171      IF( llsend_ea )   CALL mppsend( 2, zsnd_ea(1,1,1,1,1), isize, noea, ireq_ea ) 
    173172      ! blocking receive of the western/eastern halo in local temporary arrays 
    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 ) 
     173      IF( llrecv_we )   CALL mpprecv( 2, zrcv_we(1,1,1,1,1), isize, nowe ) 
     174      IF( llrecv_ea )   CALL mpprecv( 1, zrcv_ea(1,1,1,1,1), isize, noea ) 
    176175      ! 
    177176      IF( ln_timing ) CALL tic_tac(.FALSE.) 
     
    188187      CASE ( jpfillnothing )               ! no filling  
    189188      CASE ( jpfillmpi   )                 ! use data received by MPI  
    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 
     189         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls 
     190            ARRAY_IN(ji,jj,jk,jl,jf) = zrcv_we(ji,jj,jk,jl,jf)   ! 1 -> nn_hls 
    192191         END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
    193192      CASE ( jpfillperio )                 ! use east-weast periodicity 
    194193         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) 
     194         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls 
     195            ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf) 
    197196         END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
    198197      CASE ( jpfillcopy  )                 ! filling with inner domain values 
    199198         DO jf = 1, ipf                               ! number of arrays to be treated 
    200199            IF( .NOT. NAT_IN(jf) == 'F' ) THEN        ! do nothing for F point 
    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) 
     200               DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls 
     201                  ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(nn_hls+1,jj,jk,jl,jf) 
    203202               END DO   ;   END DO   ;   END DO   ;   END DO 
    204203            ENDIF 
     
    207206         DO jf = 1, ipf                               ! number of arrays to be treated 
    208207            IF( .NOT. NAT_IN(jf) == 'F' ) THEN        ! do nothing for F point 
    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 
     208               DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls 
     209                  ARRAY_IN(ji,jj,jk,jl,jf) = zland 
    211210               END DO;   END DO   ;   END DO   ;   END DO 
    212211            ENDIF 
     
    220219      CASE ( jpfillnothing )               ! no filling  
    221220      CASE ( jpfillmpi   )                 ! use data received by MPI  
    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 
     221         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls 
    223222            ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zrcv_ea(ji,jj,jk,jl,jf)   ! jpi - nn_hls + 1 -> jpi 
    224223         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    225224      CASE ( jpfillperio )                 ! use east-weast periodicity 
    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 
     225         ishift2 = nn_hls 
     226         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls 
    228227            ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ishift2+ji,jj,jk,jl,jf) 
    229228         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    230229      CASE ( jpfillcopy  )                 ! filling with inner domain values 
    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) 
     230         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls 
     231            ARRAY_IN(ishift+ji,jj,jk,jl,jf) = ARRAY_IN(ishift,jj,jk,jl,jf) 
    234232         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    235233      CASE ( jpfillcst   )                 ! filling with constant value 
    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 
     234         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, jpj   ;   DO ji = 1, nn_hls 
    237235            ARRAY_IN(ishift+ji,jj,jk,jl,jf) = zland 
    238236         END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
     
    260258      ! ---------------------------------------------------- ! 
    261259      ! 
    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       
     260      IF( llsend_so )   ALLOCATE( zsnd_so(jpi,nn_hls,ipk,ipl,ipf) ) 
     261      IF( llsend_no )   ALLOCATE( zsnd_no(jpi,nn_hls,ipk,ipl,ipf) ) 
     262      IF( llrecv_so )   ALLOCATE( zrcv_so(jpi,nn_hls,ipk,ipl,ipf) ) 
     263      IF( llrecv_no )   ALLOCATE( zrcv_no(jpi,nn_hls,ipk,ipl,ipf) ) 
     264      ! 
     265      isize = jpi * nn_hls * ipk * ipl * ipf       
    268266 
    269267      ! allocate local temporary arrays to be sent/received. Fill arrays to be sent 
    270268      IF( llsend_so ) THEN   ! copy sourhern side of the inner mpi domain in local temporary array to be sent by MPI 
    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 
     269         ishift = nn_hls 
     270         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi 
    273271            zsnd_so(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift+jj,jk,jl,jf)   ! nn_hls+1 -> 2*nn_hls 
    274272         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
     
    277275      IF( llsend_no ) THEN   ! copy eastern side of the inner mpi domain in local temporary array to be sent by MPI 
    278276         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 
     277         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi 
    280278            zsnd_no(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift+jj,jk,jl,jf)   ! jpj-2*nn_hls+1 -> jpj-nn_hls 
    281279         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
     
    285283      ! 
    286284      ! non-blocking send of the southern/northern side 
    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 ) 
     285      IF( llsend_so )   CALL mppsend( 3, zsnd_so(1,1,1,1,1), isize, noso, ireq_so ) 
     286      IF( llsend_no )   CALL mppsend( 4, zsnd_no(1,1,1,1,1), isize, nono, ireq_no ) 
    289287      ! blocking receive of the southern/northern halo 
    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 ) 
     288      IF( llrecv_so )   CALL mpprecv( 4, zrcv_so(1,1,1,1,1), isize, noso ) 
     289      IF( llrecv_no )   CALL mpprecv( 3, zrcv_no(1,1,1,1,1), isize, nono ) 
    292290      ! 
    293291      IF( ln_timing ) CALL tic_tac(.FALSE.) 
     
    303301      CASE ( jpfillnothing )               ! no filling  
    304302      CASE ( jpfillmpi   )                 ! use data received by MPI  
    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 
     303         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi 
     304            ARRAY_IN(ji,jj,jk,jl,jf) = zrcv_so(ji,jj,jk,jl,jf)   ! 1 -> nn_hls 
    307305         END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
    308306      CASE ( jpfillperio )                 ! use north-south periodicity 
    309307         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) 
     308         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi 
     309            ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf) 
    312310         END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
    313311      CASE ( jpfillcopy  )                 ! filling with inner domain values 
    314312         DO jf = 1, ipf                               ! number of arrays to be treated 
    315313            IF( .NOT. NAT_IN(jf) == 'F' ) THEN        ! do nothing for F point 
    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) 
     314               DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi 
     315                  ARRAY_IN(ji,jj,jk,jl,jf) = ARRAY_IN(ji,nn_hls+1,jk,jl,jf) 
    318316               END DO   ;   END DO   ;   END DO   ;   END DO 
    319317            ENDIF 
     
    322320         DO jf = 1, ipf                               ! number of arrays to be treated 
    323321            IF( .NOT. NAT_IN(jf) == 'F' ) THEN        ! do nothing for F point 
    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 
     322               DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi  
     323                  ARRAY_IN(ji,jj,jk,jl,jf) = zland 
    326324               END DO;   END DO   ;   END DO   ;   END DO 
    327325            ENDIF 
     
    335333      CASE ( jpfillnothing )               ! no filling  
    336334      CASE ( jpfillmpi   )                 ! use data received by MPI  
    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 
     335         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi 
    338336            ARRAY_IN(ji,ishift+jj,jk,jl,jf) = zrcv_no(ji,jj,jk,jl,jf)   ! jpj-nn_hls+1 -> jpj 
    339337         END DO   ;   END DO   ;   END DO   ;   END DO   ;   END DO 
    340338      CASE ( jpfillperio )                 ! use north-south periodicity 
    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 
     339         ishift2 = nn_hls 
     340         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi 
    343341            ARRAY_IN(ji,ishift+jj,jk,jl,jf) = ARRAY_IN(ji,ishift2+jj,jk,jl,jf) 
    344342         END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
    345343      CASE ( jpfillcopy  )                 ! filling with inner domain values 
    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) 
     344         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi 
     345            ARRAY_IN(ji,ishift+jj,jk,jl,jf) = ARRAY_IN(ji,ishift,jk,jl,jf) 
    349346         END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
    350347      CASE ( jpfillcst   )                 ! filling with constant value 
    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 
     348         DO jf = 1, ipf   ;   DO jl = 1, ipl   ;   DO jk = 1, ipk   ;   DO jj = 1, nn_hls   ;   DO ji = 1, jpi 
    352349            ARRAY_IN(ji,ishift+jj,jk,jl,jf) = zland 
    353350         END DO;   END DO   ;   END DO   ;   END DO   ;   END DO 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/LBC/mpp_nfd_generic.h90

    r12586 r12719  
    4848   SUBROUTINE ROUTINE_NFD( ptab, cd_nat, psgn, kfld ) 
    4949      !!---------------------------------------------------------------------- 
    50       ARRAY_TYPE(1-nn_hls+1:,1-nn_hls+1:,:,:,:)   ! array or pointer of arrays on which the boundary condition is applied 
     50      ARRAY_TYPE(:,:,:,:,:)   ! array or pointer of arrays on which the boundary condition is applied 
    5151      CHARACTER(len=1) , INTENT(in   ) ::   NAT_IN(:)   ! nature of array grid-points 
    5252      REAL(wp)         , INTENT(in   ) ::   SGN_IN(:)   ! sign used across the north fold boundary 
     
    8080         ALLOCATE(ipj_s(ipf)) 
    8181 
    82          ijpj      = 2 + nn_hls - 1           ! Max 2nd dimension of message transfers (last two j-line only) 
    83          ipj_s(:) = 1 + nn_hls - 1           ! Real 2nd dimension of message transfers (depending on perf requirement) 
     82         ijpj     = 2 + nn_hls -1           ! Max 2nd dimension of message transfers (last two j-line only) 
     83         ipj_s(:) = 1 + nn_hls -1           ! Real 2nd dimension of message transfers (depending on perf requirement) 
    8484                                 ! by default, only one line is exchanged 
    8585 
     
    9898         IF ( l_full_nf_update .OR.                          &    ! if coupling fields 
    9999              ( ncom_stp == nit000 .AND. .NOT. ln_rstart ) ) &    ! at first time step, if not restart 
    100             ipj_s(:) = 2 + nn_hls - 1  
     100            ipj_s(:) = 2 + nn_hls -1 
    101101 
    102102         ! Index of modifying lines in input 
     
    110110               ! 
    111111               CASE ( 'T' , 'W' ,'U' )                            ! T-, U-, W-point 
    112                      DO ji = 1, nn_hls+1 
    113                   jj_s(jf,ji) = nlcj - 2*nn_hls +ji -1 
    114                ENDDO 
     112                  DO ji = 1, nn_hls+1 
     113                     jj_s(jf,ji) = nlcj - 2*nn_hls +ji -1 
     114                  ENDDO 
    115115               CASE ( 'V' , 'F' )                                 ! V-, F-point 
    116                DO ji = 1, nn_hls+1 
    117                   jj_s(jf,ji) = nlcj - 2*nn_hls +ji - 2 
    118                ENDDO 
     116                  DO ji = 1, nn_hls+1 
     117                     jj_s(jf,ji) = nlcj - 2*nn_hls +ji - 2 
     118                  ENDDO 
    119119               END SELECT 
    120120            ! 
     
    123123               ! 
    124124               CASE ( 'T' , 'W' ,'U' )                            ! T-, U-, W-point 
    125                DO ji = 1, nn_hls 
    126                   jj_s(jf,ji) = nlcj - 2*nn_hls + ji      
    127                ENDDO 
    128                ipj_s(jf) = nn_hls                  ! need only one line anyway 
     125                  DO ji = 1, nn_hls 
     126                     jj_s(jf,ji) = nlcj - 2*nn_hls + ji 
     127                  ENDDO 
     128                  ipj_s(jf) = nn_hls                  ! need only one line anyway 
    129129               CASE ( 'V' , 'F' )                                 ! V-, F-point 
    130                DO ji = 1, nn_hls+1 
    131                   jj_s(jf,ji) = nlcj - 2*nn_hls +ji -1 
    132                ENDDO 
     130                  DO ji = 1, nn_hls+1 
     131                     jj_s(jf,ji) = nlcj - 2*nn_hls +ji -1 
     132                  ENDDO 
    133133               END SELECT 
    134134            ! 
     
    139139         ipf_j = sum (ipj_s(:))      ! Total number of lines to be exchanged 
    140140         ! 
    141          ALLOCATE( znorthloc(1-nn_hls+1:jpimax,ipf_j,ipk,ipl,1) ) 
     141         ALLOCATE( znorthloc(jpimax,ipf_j,ipk,ipl,1) ) 
    142142         ! 
    143143         js = 0 
     
    147147               DO jl = 1, ipl 
    148148                  DO jk = 1, ipk 
    149                      znorthloc(1-nn_hls+1:jpi,js,jk,jl,1) = ARRAY_IN(1-nn_hls+1:jpi,jj_s(jf,jj),jk,jl,jf) 
     149                     znorthloc(1:jpi,js,jk,jl,1) = ARRAY_IN(1:jpi,jj_s(jf,jj),jk,jl,jf) 
    150150                  END DO 
    151151               END DO 
     
    153153         END DO 
    154154         ! 
    155          ibuffsize = (jpimax + nn_hls -1) * ipf_j * ipk * ipl 
    156          ! 
    157          ALLOCATE( zfoldwk(1-nn_hls+1:jpimax,ipf_j,ipk,ipl,1) ) 
    158          ALLOCATE( ztabr(1-nn_hls+1:(jpi+nn_hls-1)*jpmaxngh-nn_hls+1,ijpj,ipk,ipl,ipf) )  
     155         ibuffsize = jpimax * ipf_j * ipk * ipl 
     156         ! 
     157         ALLOCATE( zfoldwk(jpimax,ipf_j,ipk,ipl,1) ) 
     158         ALLOCATE( ztabr(jpimax*jpmaxngh,ijpj,ipk,ipl,ipf) )  
    159159         ! when some processors of the north fold are suppressed,  
    160160         ! values of ztab* arrays corresponding to these suppressed domain won't be defined  
     
    177177               iilb = nimppt(iproc+1) 
    178178               ilci = nlcit (iproc+1) 
    179                ildi = nldit (iproc+1) 
    180                ilei = nleit (iproc+1) 
    181                IF( iilb            ==      1 )   ildi = 1      ! e-w boundary already done -> force to take 1st column 
    182                IF( iilb + ilci - 1 == jpiglo )   ilei = ilci   ! e-w boundary already done -> force to take last column 
     179               ildi = nldit (iproc+1) + nn_hls-1 
     180               ilei = nleit (iproc+1) + nn_hls-1 
     181               IF( iilb            ==      1 )   ildi = nn_hls   ! e-w boundary already done -> force to take 1st column 
     182               IF( iilb + ilci - 1 == jpiglo )   ilei = nlei+1   ! e-w boundary already done -> force to take last column 
    183183               iilb = nfiimpp(isendto(jr),jpnj) - nfiimpp(isendto(1),jpnj) 
    184184            ENDIF 
     
    191191                     DO jk = 1, ipk 
    192192                        DO ji = ildi, ilei 
    193                            ztabr(iilb+ji,jj,jk,jl,jf) = zfoldwk(ji,js,jk,jl,1) 
     193                           ztabr(iilb-nn_hls+1+ji,jj,jk,jl,jf) = zfoldwk(ji,js,jk,jl,1) 
    194194                        END DO 
    195195                     END DO 
     
    201201                     DO jk = 1, ipk 
    202202                        DO ji = ildi, ilei 
    203                            ztabr(iilb+ji,jj,jk,jl,jf) = ARRAY_IN(ji,jj_s(jf,jj),jk,jl,jf) 
     203                           ztabr(iilb-nn_hls+1+ji,jj,jk,jl,jf) = ARRAY_IN(ji,jj_s(jf,jj),jk,jl,jf) 
    204204                        END DO 
    205205                     END DO 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/TRA/traadv_mus.F90

    r12601 r12719  
    8383      LOGICAL                                  , INTENT(in   ) ::   ld_msc_ups      ! use upstream scheme within muscl 
    8484      REAL(wp)                                 , INTENT(in   ) ::   p2dt            ! tracer time-step 
    85       REAL(wp), POINTER, DIMENSION(:,:,:    )           , INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume flux components 
    86       REAL(wp), POINTER, DIMENSION(:,:,:,:,:)           , INTENT(inout) ::   pt              ! tracers and RHS of tracer equation 
     85      REAL(wp), POINTER, DIMENSION(:,:,:)      , INTENT(in   ) ::   pU, pV, pW      ! 3 ocean volume flux components 
     86      REAL(wp), POINTER, DIMENSION(:,:,:,:,:)  , INTENT(inout) ::   pt              ! tracers and RHS of tracer equation 
    8787      ! 
    8888      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
     
    9696      CALL halo_mng_set(jphls) 
    9797 
    98       ALLOCATE(zwx(jplbi:jpi,jplbj:jpj,jpk)) 
    99       ALLOCATE(zwy(jplbi:jpi,jplbj:jpj,jpk)) 
    100       ALLOCATE(zslpx(jplbi:jpi,jplbj:jpj,jpk)) 
    101       ALLOCATE(zslpy(jplbi:jpi,jplbj:jpj,jpk)) 
     98      ALLOCATE(zwx(jpi,jpj,jpk)) 
     99      ALLOCATE(zwy(jpi,jpj,jpk)) 
     100      ALLOCATE(zslpx(jpi,jpj,jpk)) 
     101      ALLOCATE(zslpy(jpi,jpj,jpk)) 
    102102 
    103103      CALL halo_mng_resize(r1_e1e2t,'T', 1._wp) 
     
    105105      CALL halo_mng_resize(r1_e1e2v,'V', 1._wp) 
    106106      CALL halo_mng_resize(tmask,'T', 1._wp) 
    107       CALL halo_mng_resize(wmask, 'W', 1._wp) 
    108       CALL halo_mng_resize(umask, 'U', 1._wp) 
    109       CALL halo_mng_resize(vmask, 'V', 1._wp) 
     107      CALL halo_mng_resize(wmask,'W', 1._wp) 
     108      CALL halo_mng_resize(umask,'U', 1._wp) 
     109      CALL halo_mng_resize(vmask,'V', 1._wp) 
    110110      CALL halo_mng_resize(pt, 'T', 1._wp, kjpt=kjpt, fjpt=Kbb ) 
    111111      CALL halo_mng_resize(pt, 'T', 1._wp, kjpt=kjpt, fjpt=Krhs ) 
    112112      CALL halo_mng_resize(e3t,'T', 1._wp, fillval=1._wp, fjpt=Kmm) 
    113       CALL halo_mng_resize(e3u, 'U', 1._wp, fillval=1._wp, fjpt=Kmm ) 
    114       CALL halo_mng_resize(e3v, 'V', 1._wp, fillval=1._wp, fjpt=Kmm) 
    115       CALL halo_mng_resize(e3w, 'W', 1._wp, fillval=1._wp, fjpt=Kmm) 
     113      CALL halo_mng_resize(e3u,'U', 1._wp, fillval=1._wp, fjpt=Kmm ) 
     114      CALL halo_mng_resize(e3v,'V', 1._wp, fillval=1._wp, fjpt=Kmm) 
     115      CALL halo_mng_resize(e3w,'W', 1._wp, fillval=1._wp, fjpt=Kmm) 
    116116      CALL halo_mng_resize(pU, 'U', -1._wp) 
    117117      CALL halo_mng_resize(pV, 'V', -1._wp) 
    118118      CALL halo_mng_resize(pW, 'W', 1._wp) 
    119       !       
    120       IF( ln_isfcav ) CALL halo_mng_resize(mikt, 'T', 1._wp) 
    121       IF( ld_msc_ups) CALL halo_mng_resize(rnfmsk, 'T', 1._wp) 
    122       IF( ld_msc_ups) CALL halo_mng_resize(upsmsk, 'T', 1._wp) 
     119      ! 
     120      IF( ln_isfcav ) CALL halo_mng_resize(mikt,  'T', 1._wp) 
     121      IF( ld_msc_ups) CALL halo_mng_resize(rnfmsk,'T', 1._wp) 
     122      IF( ld_msc_ups) CALL halo_mng_resize(upsmsk,'T', 1._wp) 
    123123 
    124124      IF( kt == kit000 )  THEN 
     
    131131         ! Upstream / MUSCL scheme indicator 
    132132         ! 
    133          ALLOCATE( xind(jplbi:jpi,jplbj:jpj,jpk), STAT=ierr ) 
     133         ALLOCATE( xind(jpi,jpj,jpk), STAT=ierr ) 
    134134         xind(:,:,:) = 1._wp              ! set equal to 1 where up-stream is not needed 
    135135         ! 
    136136         IF( ld_msc_ups ) THEN            ! define the upstream indicator (if asked) 
    137             ALLOCATE( upsmsk(jplbi:jpi,jplbj:jpj), STAT=ierr ) 
     137            ALLOCATE( upsmsk(jpi,jpj), STAT=ierr ) 
    138138            upsmsk(:,:) = 0._wp                             ! not upstream by default 
    139139            ! 
     
    146146         ! 
    147147      ENDIF  
    148  
     148      !       
    149149      l_trd = .FALSE. 
    150150      l_hst = .FALSE. 
     
    162162         zwx(:,:,jpk) = 0._wp                   ! bottom values 
    163163         zwy(:,:,jpk) = 0._wp   
    164          DO_3D_20_20( 1, jpkm1 ) 
     164         DO_3D_10_10( 1, jpkm1 ) 
    165165            zwx(ji,jj,jk) = umask(ji,jj,jk) * ( pt(ji+1,jj,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 
    166166            zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( pt(ji,jj+1,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 
    167167         END_3D 
    168          !  
     168         ! lateral boundary conditions   (changed sign) 
     169         !CALL lbc_lnk_multi( 'traadv_mus', zwx, 'U', -1. , zwy, 'V', -1. ) 
    169170         !                                !-- Slopes of tracer 
    170171         zslpx(:,:,jpk) = 0._wp                 ! bottom values 
    171172         zslpy(:,:,jpk) = 0._wp 
    172          DO_3D_31_31( 1, jpkm1 ) 
     173         DO_3D_01_01( 1, jpkm1 ) 
    173174            zslpx(ji,jj,jk) =                    ( zwx(ji,jj,jk) + zwx(ji-1,jj  ,jk) )   & 
    174175               &            * ( 0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji-1,jj  ,jk) ) ) 
     
    177178         END_3D 
    178179         ! 
    179          DO_3D_31_31( 1, jpkm1 ) 
     180         DO_3D_01_01( 1, jpkm1 ) 
    180181            zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji  ,jj,jk) ),   & 
    181182               &                                                 2.*ABS( zwx  (ji-1,jj,jk) ),   & 
     
    186187         END_3D 
    187188         ! 
    188          DO_3D_30_30( 1, jpkm1 ) 
     189         DO_3D_00_00( 1, jpkm1 ) 
    189190            ! MUSCL fluxes 
    190191            z0u = SIGN( 0.5, pU(ji,jj,jk) ) 
     
    202203            zwy(ji,jj,jk) = pV(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 
    203204         END_3D 
    204          ! 
    205          DO_3D_30_30( 1, jpkm1 ) 
     205         !CALL lbc_lnk_multi( 'traadv_mus', zwx, 'U', -1. , zwy, 'V', -1. )   ! lateral boundary conditions   (changed sign) 
     206         ! 
     207         DO_3D_00_00( 1, jpkm1 ) 
    206208            pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )       & 
    207209            &                                     + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  ) )     & 
     
    228230         !                                !-- Slopes of tracer 
    229231         zslpx(:,:,1) = 0._wp                   ! surface values 
    230          DO_3D_21_21( 2, jpkm1 ) 
     232         DO_3D_11_11( 2, jpkm1 ) 
    231233            zslpx(ji,jj,jk) =                     ( zwx(ji,jj,jk) + zwx(ji,jj,jk+1) )  & 
    232234               &            * (  0.25 + SIGN( 0.25, zwx(ji,jj,jk) * zwx(ji,jj,jk+1) )  ) 
    233235         END_3D 
    234          DO_3D_21_21( 2, jpkm1 ) 
     236         DO_3D_11_11( 2, jpkm1 ) 
    235237            zslpx(ji,jj,jk) = SIGN( 1., zslpx(ji,jj,jk) ) * MIN(    ABS( zslpx(ji,jj,jk  ) ),   & 
    236238               &                                                 2.*ABS( zwx  (ji,jj,jk+1) ),   & 
    237239               &                                                 2.*ABS( zwx  (ji,jj,jk  ) )  ) 
    238240         END_3D 
    239          DO_3D_30_30( 1, jpk-2 ) 
     241         DO_3D_00_00( 1, jpk-2 ) 
    240242            z0w = SIGN( 0.5, pW(ji,jj,jk+1) ) 
    241243            zalpha = 0.5 + z0w 
     
    247249         IF( ln_linssh ) THEN                   ! top values, linear free surface only 
    248250            IF( ln_isfcav ) THEN                      ! ice-shelf cavities (top of the ocean) 
    249                DO_2D_21_21 
     251               DO_2D_11_11 
    250252                  zwx(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kbb) 
    251253               END_2D 
     
    255257         ENDIF 
    256258         ! 
    257          DO_3D_30_30( 1, jpkm1 ) 
     259         DO_3D_00_00( 1, jpkm1 ) 
    258260            pt(ji,jj,jk,jn,Krhs) =  pt(ji,jj,jk,jn,Krhs) - ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
    259261         END_3D 
     
    262264         ! 
    263265      END DO                     ! end of tracer loop 
    264       ! 
     266 
    265267      DEALLOCATE(zwx,zwy) 
    266268      DEALLOCATE(zslpx,zslpy) 
    267269 
    268270      CALL halo_mng_set(1) 
    269  
     271      ! 
    270272      CALL halo_mng_resize(r1_e1e2t,'T', 1._wp) 
    271273      CALL halo_mng_resize(r1_e1e2u,'U', 1._wp) 
    272274      CALL halo_mng_resize(r1_e1e2v,'V', 1._wp) 
    273       CALL halo_mng_resize(pt, 'T', 1._wp, kjpt=kjpt, fjpt=Kbb ) 
    274       CALL halo_mng_resize(pt, 'T', 1._wp, kjpt=kjpt, fjpt=Krhs ) 
     275      CALL halo_mng_resize(pt,'T', 1._wp, kjpt=kjpt, fjpt=Kbb ) 
     276      CALL halo_mng_resize(pt,'T', 1._wp, kjpt=kjpt, fjpt=Krhs ) 
    275277      CALL halo_mng_resize(tmask,'T', 1._wp) 
    276       CALL halo_mng_resize(wmask, 'W', 1._wp) 
    277       CALL halo_mng_resize(umask, 'U', 1._wp) 
    278       CALL halo_mng_resize(vmask, 'V', 1._wp) 
     278      CALL halo_mng_resize(wmask,'W', 1._wp) 
     279      CALL halo_mng_resize(umask,'U', 1._wp) 
     280      CALL halo_mng_resize(vmask,'V', 1._wp) 
    279281      CALL halo_mng_resize(e3t,'T', 1._wp, fillval=1._wp, fjpt=Kmm) 
    280       CALL halo_mng_resize(e3u, 'U', 1._wp, fillval=1._wp, fjpt=Kmm) 
    281       CALL halo_mng_resize(e3v, 'V', 1._wp, fillval=1._wp, fjpt=Kmm) 
    282       CALL halo_mng_resize(e3w, 'W', 1._wp, fillval=1._wp, fjpt=Kmm) 
    283       CALL halo_mng_resize(pU, 'U', 1._wp) 
    284       CALL halo_mng_resize(pV, 'V', 1._wp) 
    285       CALL halo_mng_resize(pW, 'W', 1._wp) 
     282      CALL halo_mng_resize(e3u,'U', 1._wp, fillval=1._wp, fjpt=Kmm) 
     283      CALL halo_mng_resize(e3v,'V', 1._wp, fillval=1._wp, fjpt=Kmm) 
     284      CALL halo_mng_resize(e3w,'W', 1._wp, fillval=1._wp, fjpt=Kmm) 
     285      CALL halo_mng_resize(pU,'U', 1._wp) 
     286      CALL halo_mng_resize(pV,'V', 1._wp) 
     287      CALL halo_mng_resize(pW,'W', 1._wp) 
    286288 
    287289      IF( ln_isfcav ) CALL halo_mng_resize(mikt, 'T', 1._wp) 
    288290      IF( ld_msc_ups) CALL halo_mng_resize(rnfmsk, 'T', 1._wp) 
    289291      IF( ld_msc_ups) CALL halo_mng_resize(upsmsk, 'T', 1._wp) 
    290  
    291292   END SUBROUTINE tra_adv_mus 
    292293 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/do_loop_substitute.h90

    r12586 r12719  
    5959#define __kIsm1_   1 
    6060#define __kJsm1_   1 
    61 # 
    62 #define __kIsmh_   jplbi 
    63 #define __kJsmh_   jplbj 
    64 #define __kIsmhp1_   jplbi+1 
    65 #define __kJsmhp1_   jplbj+1 
    6661 
    6762#define __kIe_     jpi-1 
     
    8378#define DO_2D_10_10   DO jj = __kJsm1_, __kJe_   ;   DO ji = __kIsm1_, __kIe_ 
    8479#define DO_2D_10_11   DO jj = __kJsm1_, __kJe_   ;   DO ji = __kIsm1_, __kIep1_ 
    85 # 
    86 #define DO_2D_20_20   DO jj = __kJsmh_, __kJe_   ;   DO ji = __kIsmh_, __kIe_ 
    87 #define DO_2D_21_21   DO jj = __kJsmh_, __kJep1_   ;   DO ji = __kIsmh_, __kIep1_ 
    88 #define DO_2D_31_31   DO jj = __kJsmhp1_, __kJep1_ ;   DO ji = __kIsmhp1_, __kIep1_ 
    89 #define DO_2D_30_30   DO jj = __kJsmhp1_, __kJe_   ;   DO ji = __kIsmhp1_, __kIe_ 
    9080  
    9181#define DO_2D_11_00   DO jj = __kJsm1_, __kJep1_   ;   DO ji = __kIs_, __kIe_ 
     
    10292#define DO_3D_10_10(ks,ke)   DO jk = ks, ke   ;   DO_2D_10_10 
    10393#define DO_3D_10_11(ks,ke)   DO jk = ks, ke   ;   DO_2D_10_11 
    104 # 
    105 #define DO_3D_20_20(ks,ke)   DO jk = ks, ke   ;   DO_2D_20_20 
    106 #define DO_3D_21_21(ks,ke)   DO jk = ks, ke   ;   DO_2D_21_21 
    107 #define DO_3D_31_31(ks,ke)   DO jk = ks, ke   ;   DO_2D_31_31 
    108 #define DO_3D_30_30(ks,ke)   DO jk = ks, ke   ;   DO_2D_30_30 
    10994  
    11095#define DO_3D_11_11(ks,ke)   DO jk = ks, ke   ;   DO_2D_11_11 
    111 #define DO_3D_21_21(ks,ke)   DO jk = ks, ke   ;   DO_2D_21_21 
    11296 
    11397#define DO_3DS_00_00(ks,ke,ki)   DO jk = ks, ke, ki   ;   DO_2D_00_00 
  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/OCE/par_oce.F90

    r12586 r12719  
    6161   INTEGER, PUBLIC ::   jpimax! = ( jpiglo-2*nn_hls + (jpni-1) ) / jpni + 2*nn_hls !: maximum jpi 
    6262   INTEGER, PUBLIC ::   jpjmax! = ( jpjglo-2*nn_hls + (jpnj-1) ) / jpnj + 2*nn_hls !: maximum jpj 
    63    INTEGER, PUBLIC ::   jplbi 
    64    INTEGER, PUBLIC ::   jplbj 
    6563 
    6664   !!--------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.